ארכיון תגיות: excel

פרוצדורת VBA למחיקת עיצובים מותאמים אישית ב-Excel

יש הטוענים שעיצובים אלו יוצרים בעיות

להלן פונקציה שמוחקת אותם

השורה On error resume next מיועדת בין השאר, למצבים שהגיליון שמכיל עיצוב כזה – נעול, במצב כזה, תתקבל תקלה.

Sub StyleKill()
     Dim styT As Style
     Dim intRet As Integer
     On Error Resume Next
     For Each styT In ActiveWorkbook.Styles
         If Not styT.BuiltIn Then
             If styT.name <> "1" Then styT.Delete
         End If
     Next styT
 End Sub

מקור כאן

פונקצית VBA לחישוב ערכים באמצעות אקסל חיצוני (למשל מאקסס או מוורד)

לפעמים, הלקוח מעוניין לשמר בידיו את היכולת לשלוט בלוגיקה מסויימת בתוכנה
או לחלופין שהלוגיקה העסקית כבר קיימת בצורה טובה באקסל, ולחץ הזמנים בפרויקט לא מאפשר להעביר אותה במלואה לשפת הפיתוח.
במקרה כזה, אפשר פשוט להשתמש באקסל ברקע.

להלן פונקציה שכתבתי ששולחת נתונים לאקסל, ומקבלת בחזרה נתונים לאחר החישוב

פונקציה זו נועדה לחשב דברים באמצעות אקסל
יש לספק 3 פרמטרים:
1. שם הקובץ
2. מערך המכיל את המידע שיש לשתול באקסל
3. מערך המכיל את התאים שיש לקבל מאקסל
הפונקציה שותלת את המערך מהפרמטר השני
ואז ממלאת את המערך מהפרמטר השלישי ומחזירה אותו
כלומר תוצאה הפונקציה היא מערך!
במקרה של תקלה – תוצאה הפונקציה תהיה בוליאנית – שקר

מבנה המערכים –
שתי המערכים באותו מבנה – דו מימדי, כאשר תיאור העמודות נשמר ב
ENUM = E_XL_DataAry

מבנה המידע שחוזר –
המידע שחוזר הוא מערך דו מימדי כאשר יש לציין
אם ביקשת לקבל טווח של תאים, אזי התא במערך שמכיל את מה שביקשת – יהיה מערך בפני עצמו
כאשר זהו מערך דו מימדי , המימד הראשון – השורות באקסל , החל מאחד
המימד השני – העמודות באקסל – החל מאחד
השורות והעמודות הם יחסיות לטווח שביקשת, כלומר תמיד יתחילו מאחד, עד כמה שצריך.

הערה : הפונקציה שמוזכרת פה IsArrayAllocated, היא פונקציה רק שבודקת האם זהו מערך תקין, ואינה מחויבת (היא לא חלק מ-VBA, אלא בנפרד).

Public Enum E_XL_DataAry
    
    SheetNameCol = 0
    CellAddressCol = 1
    ValueCol = 2

End Enum


Public Function CalculateByExcel(file_name As String, DataToPutAry As Variant, DataToGetAry As Variant) As Variant
    
    Dim xl As Object, wb As Object, ws As Object, I As Integer
    'open the xl
    Set xl = CreateObject("Excel.Application")
    xl.Visible = False
    Set wb = xl.Workbooks.Open(file_name, 2, True)
    
    If (Not IsArrayAllocated(DataToPutAry)) Or (Not IsArrayAllocated(DataToGetAry)) Then GoTo Err_Handel
    
    'Put Data into cells
    For I = LBound(DataToPutAry) To UBound(DataToPutAry)
            wb.Worksheets(DataToPutAry(I, E_XL_DataAry.SheetNameCol)).range(DataToPutAry(I, E_XL_DataAry.CellAddressCol)).Value = DataToPutAry(I, E_XL_DataAry.ValueCol)
    Next I
    
    For I = LBound(DataToGetAry) To UBound(DataToGetAry)
            DataToGetAry(I, E_XL_DataAry.ValueCol) = wb.Worksheets(DataToGetAry(I, E_XL_DataAry.SheetNameCol)).range(DataToGetAry(I, E_XL_DataAry.CellAddressCol)).Value
    Next I
     
    CalculateByExcel = DataToGetAry
     
    wb.Close False ' close the source workbook without saving any changes
    Set wb = Nothing
    xl.Quit
    Set xl = Nothing

Exit_Func:
    Exit Function


Err_Handel:
    CalculateByExcel = False
    Resume Exit_Func
    
End Function

דוגמא לשימוש פשוט – כאשר מוחזר רק תא אחד בודד


Sub TryIt()
Dim x As Variant, a As Variant, b As Variant
ReDim a(0, 3)
a(0, 0) = "Sheet1"
a(0, 1) = "A1"
a(0, 2) = "1"
ReDim b(0, 3)
b(0, 0) = "Sheet1"
b(0, 1) = "A2"


x = CalculateByExcel("YourXLFile.xlsx", a, b)
Debug.Print x(0, 2)

End Sub

ודוגמא לשימוש מורכב יותר, כאשר מוחזר טווח של 2 תאים לדוגמא


Dim x As Variant, a As Variant, b As Variant
ReDim a(0, 3)
a(0, 0) = "Sheet1"
a(0, 1) = "A1"
a(0, 2) = "1"
ReDim b(0, 3)
b(0, 0) = "Sheet1"
b(0, 1) = "A2:A3"


x = CalculateByExcel("YourXLFile.xlsx", a, b)
Debug.Print x(0, 2)(1,1)

End Sub

בהצלחה!

פתרון לטופס UserForm של Excel VBA שגורם לקריסה "נאלץ להיסגר…"

היה לי פרויקט ענק, של UserForm שמשלב הרבה מאוד פקדים.

והיו הרבה פעמים , שהוא פשוט קרס, עם הודעת "שגיאה לא ידועה, אקסל נאלץ להיסגר " וכו' וכו'.

הצורה היחידה שיכולתי לעבוד איתו, היא רק אם הייתי מקמפל אותו לפני ההרצה שוב פעם (סתם, ללא סיבה).

בסופו של דבר מצאתי את הפתרון הבא :
לא להתייחס לפקדים בצורה ישירה
אלא רק כמחרוזת בתוך Item של אוביקט Controls

כלומר ככה :

UserForm1.Controls.Item("ControlName").Parameter

וזה עובד!

את המקור מצאתי כאן.

בהצלחה!

עדכון 15-7-2014 למניינם :
בטפסים *גדולים* בלבד, כאשר מזיזים פקדים, או משנים מאפיינים של מספר פקדים יחד, מומלץ לשמור, לצאת מאקסל ולהיכנס שוב, כיוון שאם לא, האקסל קורס בלי סיבה מספר דקות לאחר מכו.

לפתוח מסך של Access בלי להציג את הרקע של Access Application – באמצעות Windows API

הערה : לא מתאים למתכנתים מתחילים.
מצריך ידע טוב ב-VBA, כולל קומפליציה מותנית, ו-Windows API.
הערה חשובה 2 : כדי לפתוח את אקסס בלי להפעיל את מה שאמור להיות מופעל בהתחלה, פותחים אותו ומחזיקים את ה- Shift לחוץ (אלא אם כן מנעתם את זה עם סקריפט ואז אתם בבעיה).

נניח ורוצים לפתוח עם VBA
את אקסס מתוך אקסל

בצורה "נקיה"
בלי להציג את מסך הרקע של אקסס.

הפתרון שלי מבוסס על הפתרון של KNK שמופיע כאן.
והוא ביסס את הפתרון על פתרון של Dev Ashish/
ואני שיכללתי את זה טיפ טיפ.

היתרון בפתרון שלי הוא שהוא … כתוב בעברית 🙂
וגם כן תפרתי היטב את החלקים שקשורים ל-VBA7 ול-Win 64

אז ככה :
1. באפליקציה האקסס אתה חייב :
1.1 להגדיר טופס שעולה עם התחלת התוכנה
1.2 לבטל את "חלונית הניווט"
1.3 לבטל את "הצג לשוניות מסמך"

שים לב,
הטופס שעולה בהתחלה יכול להכיל לוגו , וכדומה…
אבל הוא לא יכול להיות הטופס העיקרי שאליו אתה מכוון
כי הוא משמש רק למעבר…

בטופס הזה, תגדיר טיימר , נניח של 1000 מיליסקנד
ותוסיף 2 אירועים
באירוע של OnLoad אתה מסתיר את הריבון

DoCmd.ShowToolbar "Ribbon", acToolbarNo

ובאירוע של הטיימר ,
אתה עושה 3 דברים בסדר הבא :
1. קורא ל-Windows API כדי שיסתיר את החלון של האקסס
2. סוגר את הטופס הנוכחי
3. פותח את הטופס העיקרי שלך.

בנוסף חשוב לציין
כל הטפסים, הדוחות וכו', חייבים להיות
1. מודאלים
2. מוקפצים

הדוחות – חשוב לפתוח ב-Maximaize
וחשוב להגדיר כפתור בטופס הראשי שלך עם אפשרות יציאה Application.quit

אחרי כל זה
המודול שמטפל בהסתרה מכיל את הקוד הבא :

Option Compare Database
Option Explicit
'I copy from here
'http://www3.telus.net/geo123/HideAccessShell2K7.html
'http://www.utteraccess.com/forum/Forms-Access-Background-t1958468.html

Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3

#If Win64 Then
    Private Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As LongPtr, ByVal nCmdShow As LongPtr) As LongPtr
#Else
    Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
    

Function DoAccessWindow(nCmdShow As Long)
' This function can minimize Access behind the scenes.

'Usage Examples
'Maximize window:
'       ?DoAccessWindow(SW_SHOWMAXIMIZED)
'Minimize window:
'       ?DoAccessWindow(SW_SHOWMINIMIZED)
'Hide window:
'       ?DoAccessWindow(SW_HIDE)
'Normal window:
'       ?DoAccessWindow(SW_SHOWNORMAL)
'

Dim loX  As LongPtr
Dim loform As Form
    On Error Resume Next
    Set loform = Screen.ActiveForm
    If Err <> 0 Then 'no Activeform
      If nCmdShow = SW_HIDE Then
        MsgBox "Cannot hide Access unless a form is on screen"
      Else
        loX = apiShowWindow(hWndAccessApp, nCmdShow)
        Err.Clear
      End If
    Else
        If nCmdShow = SW_SHOWMINIMIZED And loform.Modal = True Then
            MsgBox "Cannot minimize Access with " & (loform.Caption + " ") & "form on screen"
        ElseIf nCmdShow = SW_HIDE And loform.PopUp <> True Then
            MsgBox "Cannot hide Access with " & (loform.Caption + " ") & "form on screen"
        Else
            loX = apiShowWindow(hWndAccessApp, nCmdShow)
        End If
    End If
    DoAccessWindow = (loX <> 0)
End Function



ואם הגדרת הכל נכון
אתה כבר יכול לשמור, לסגור, ולהפעיל את הקובץ אקסס, ולראות שכבר זה מסתיר את הרקע של אקסס.

עכשיו לחלק המעניין.
בפתרון של KNK מופיע גם מודול של Shell שמאפשר להשתמש ב-Windows API כדי להפעיל עוד מופעים (Instances ) של Access .
אני לקחתי את זה חצי צעד קדימה ומתוך אקסל , פתחתי כבר את האוביקט אקסס
ביררתי מה מספר החלון שלו מבחינת Windows API
ועם המספר הזה, השתמשתי במודול Shell של Windows API

בבקשה ה-VBA, מתוך אקסל , מכילה פרוצדורה אחת ופונקציה אחת
את הפונקציה מבחינת סדר הייתי ממליץ לאחסן במודול נפרד.

First Sub

sub FirstSub()
Dim acs As Object, myHWD As LongPtr, yReply As LongPtr
Set acs = CreateObject("Access.Application")
acs.Application.Visible = True
myHWD = acs.Application.hWndAccessApp
yReply = fHandleFile("C:YourDB.accdb", WIN_NORMAL, myHWD)
End Sub

Seconed Function

Option Explicit

'************ Code Start **********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
#If VBA7 Then
Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hWnd As LongPtr, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As LongPtr) _
    As LongPtr


#Else
Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hWnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long
#End If
'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 2            'Open Maximized
Public Const WIN_MIN = 3            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

'***************Usage Examples***********************
'Open a folder:     ?fHandleFile("C:TEMP",WIN_NORMAL)
'Call Email app:    ?fHandleFile("mailto:dash10@hotmail.com",WIN_NORMAL)
'Open URL:          ?fHandleFile("http://home.att.net/~dashish", WIN_NORMAL)
'Handle Unknown extensions (call Open With Dialog):
'                   ?fHandleFile("C:TEMPTestThis",Win_Normal)
'Start Access instance:
'                   ?fHandleFile("I:mdbsCodeNStuff.mdb", Win_NORMAL)
'****************************************************

Function fHandleFile(stFile As String, lShowHow As Long, hWndAccessApp As LongPtr)
Dim lRet As LongPtr, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********





could not set the list property. unspecified error – תקלה כאשר מקצים מערך ל-ListBox באקסל

ובכן,
הפתרון היחיד שאני מצאתי
הוא לא להקצות מערך
אלא להשתמש ב-AddItem
וב-Column

התקלה הזאת היא "מוזרה" ומתנהגת מאוד מוזר.

כאשר מקצים מערך – לפעמים הקוד עובד, ולפעמים מקבלים את התקלה
לעומת זאת בהוספת פריטים עם AddItem , תמיד הכל רץ חלק.

כנראה באג של מיקרוסופט בפקד ListBox

דרך אגב, לידיעה, יש מגבלה של 10 עמודות (0 עד 9) בכל ListBox שאינו קשור לנתונים ( נקרא UnBound)

איך להחליף שפת הקלדה לעברית (או כל שפה) באמצעות Windows API ב-Excel VBA USERFORM

באקסס – האפשרות הזו היא אחת מה-Properties של כל פקד

באקסל – זה לא קיים.

צורה פשוטה מאוד

מגדירים את הפונקציה הבאה של Windows API
בראש הקוד

#If Win64 Then
    Public Declare PtrSafe Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As LongPtr, ByVal Flag As Long) As LongPtr
#Else
    public Declare Function ActivateKeyboardLayout Lib "user32.dll" (ByVal HKL As Long, Flag As Long) As Long
#End If



והשימוש עבור עברית הוא

call ActivateKeyboardLayout(1037,0)

מקור : www.Spreadsheet1.com

שימוש בוורד / אקסל / PP על שרת ווינדוס עם php

לאחרונה בפרויקט מסוים היינו צריכים להשתמש בתוספות COM של PHP

כלומר להפעיל בצד השרת אקסל / וורד וכדומה.

התקנו שרת ווינדוס עם Wamp , ועליו מותקנות גם התוכנות הרלוונטיות (אקסל / וורד)

כדי שתוספת ה-COM תוכל לעבוד , צריך לאפשר אותה בתהליך הבא :

  • Run “dcomcnfg” to get to Component Services
  • Open Component Services > Computers > My Computer > DCOM Config
  • Search for Microsoft Excel Application or the appropriate application you working with on COM
  • Right-Click on it and open the properties
  • Choose “Identity” tab
  • Normally this is set to “the launching user” by default. You have to change this to “the interactive user”.
  • Apply these new settings and test your COM application. It should work fine now.

מקור : http://stackoverflow.com/questions/11704440/uncaught-exception-com-exception-with-message-bsource-b-microsoft-office

 

לאחר שמאפשרים את התוספת, אפשר בקלות להשתמש ב-word/Excel –

להלן דוגמא ב-php  מתוך התיעוד הרשמי

Version}n";

//bring it to front
$word->Visible = 1;

//open an empty document
$word->Documents->Add();

//do some weird stuff
$word->Selection->TypeText("This is a test...");
$word->Documents[1]->SaveAs("Useless test.doc");

//closing word
$word->Quit();

//free the object
$word = null;
?> 

פונקציה לבדיקת האם מחרוזת מתחילה באנגלית – VBA (Access)

לפעמים צריך ליישר אוטומטית

שדה ב-VBA

לשם כך בניתי פונקציה שבודקת האם השדה מתחיל באנגלית

במידה וכן – ניישר אותו בהתאם.

Public Function StringStratInEnglish(str As String) As Boolean
 Dim first_char As String
 On Error Resume Next
 
 StringStratInEnglish = False
 
 If Len(str) = 0 Then GoTo ExitHere
 first_char = Mid(str, 1, 1)
 
 If (Asc(first_char) >= 65 And Asc(first_char) <= 90) Or _
 (Asc(first_char) >= 97 And Asc(first_char) <= 122) Then
 
 StringStratInEnglish = True
 End If
 
ExitHere:
 Exit Function
End Function

רשימת דברים שגורמים לתקלה 1004 ב- ..Validation.Add

ראיתי ברשת
שהרבה אנשים מתמודדים כמוני עם התקלה הזו
שלא ברור ממה היא נובעת

בסופו של דבר , כמעט תמיד אלו טעויות אנוש

אז הנה רשימת ChekcList קטנה לבדוק

1. הגיליון לא נעול
2. הטווח שאליו מפנים – קיים
3. בטווח אין אימות נתונים אחר (מלפני כן)

זהו