Das Wort zum Sonntag

Hi,
jeder, der mit verschiedenen Excelversionen arbeiten muss, kennt das Problem.
In neuen Version gibt es neue Objekte, Methoden, Eigenschaften und Ereignisse. Die können in niedrigeren Versionen nicht eingesetzt werden, da VB schon beim kompilieren meckert, dass es diese oder jenes nicht kennt, oder aber während der Laufzeit ein objektorientierter Fehler auftritt.
Auf diese Features wollen wir aber auch nicht verzichten. Die bedingte Kompilierung scheidet aus, da und Excel keine Konstante für die Version zur Verfügung stellt. Für jede Version ein eigenes Programm zu schreiben vervielfacht den Wartungsaufwand und ist auch keine Lösung.
Hier mal ein paar Möglichkeiten, ohne Versionskonflikt, neue Methoden und Eigenschaften zu nutzen. Getestet mit xl2000 und xl2003.

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub Beispiel1() 'neue Parameter für Methoden
    Select Case Val(Application.Version)
        Case 10, 11
            Columns(1).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=1 'xlSortTextAsNumbers
        Case 8, 9
            Columns(1).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End Select
End Sub

Public Sub Beispiel2() 'neue Eigenschaften von Objekten
    If Val(Application.Version) > 9 Then
        CallByName Application.CommandBars, "DisableCustomize", VbLet, False
        CallByName Application.CommandBars, "DisableAskAQuestionDropdown", VbLet, False
    End If
    Application.CommandBars("Toolbar List").Enabled = True
End Sub

Public Sub Beispiel3() 'neue Eigenschaften von Objekten die Objekte zurückgeben
    If Val(Application.Version) > 9 Then Application.ErrorCheckingOptions.BackgroundChecking = False
End Sub

Public Sub Beispiel4() 'neue Methoden
    If Val(Application.Version) > 9 Then Application.Windows.CompareSideBySideWith ThisWorkbook.Name
End Sub

Es fehlen natürlich noch die grundsätzlich neuen Objekte und Ereignisse. Aber das ListObject Objekt ist meiner Meinung nach für Programmierer ziemlich uninteressant. Die neuen Ereignisse wie z.B. Sync oder XmlImport, XmlExport usw. habe ich noch nie benötigt und kann mir auch keine Einsatzgebiet dafür vorstellen.
Gruß
Nepumuk

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Karl-Heinz,
AddressOf kannst du so in xl97 benutzen. Aber Achtung, ab xl2000 klappt das so nicht mehr, da muss der "normale" AddressOf Operator benutzt werden.

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias "EbGetExecutingProj" ( _
    ByRef hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" ( _
    ByVal hProject As Long, _
    ByVal strFunctionName As String, _
    ByRef strFunctionId As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" ( _
    ByVal hProject As Long, _
    ByVal strFunctionId As String, _
    ByRef lpfn As Long) As Long
Private Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" ( _
    ByVal hWnd As Long, _
    ByVal lpText As String, _
    ByVal lpCaption As String, _
    ByVal wType As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIDEvent As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any) As Long

Private Const MB_DEFBUTTON1 = &H0&
Private Const MB_DEFBUTTON2 = &H100&
Private Const MB_DEFBUTTON3 = &H200&
Private Const MB_ICONASTERISK = &H40&
Private Const MB_ICONEXCLAMATION = &H30&
Private Const MB_ICONHAND = &H10&
Private Const MB_ICONINFORMATION = MB_ICONASTERISK
Private Const MB_ICONQUESTION = &H20&
Private Const MB_ICONSTOP = MB_ICONHAND
Private Const MB_OK = &H0&
Private Const MB_OKCANCEL = &H1&
Private Const MB_YESNO = &H4&
Private Const MB_YESNOCANCEL = &H3&
Private Const MB_ABORTRETRYIGNORE = &H2&
Private Const MB_RETRYCANCEL = &H5&
Private Const GC_CLASSNAMEMSACCESS = "OMain"
Private Const GC_CLASSNAMEMSDIALOGS = "#32770"
Private Const WM_CLOSE = &H10
Private Const strBoxTitle = "Information"

Private hWnd As Long

Public Function AddrOf(strFuncName As String) As Long
    Dim hProject As Long, lResult As Long, lpfn As Long
    Dim strID As String, strFuncNameUnicode As String
    Const NO_ERROR = 0
    AddrOf = 0
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
    Call GetCurrentVbaProject(hProject)
    If hProject <> 0 Then
        lResult = GetFuncID(hProject, strFuncNameUnicode, strID)
        If lResult = NO_ERROR Then
            lResult = GetAddr(hProject, strID, lpfn)
            If lResult = NO_ERROR Then: AddrOf = lpfn
        End If
    End If
End Function

Public Sub prcMsgBox_Time()
    hWnd = FindWindow(GC_CLASSNAMEMSACCESS, vbNullString)
    SetTimer hWnd, 0&, 2000&, AddrOf("prcTimer") '2000 Millisekunden
    MessageBox hWnd, "Diese Meldung schließt sich selbst.", strBoxTitle, _
        MB_OK Or MB_ICONINFORMATION
End Sub

Private Sub prcKillBox()
    PostMessage FindWindow(GC_CLASSNAMEMSDIALOGS, strBoxTitle), WM_CLOSE, 0&, 0&
End Sub

Private Sub prcTimer(ByVal hWnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long)
    Call prcKillTimer
    Call prcKillBox
End Sub

Private Sub prcKillTimer()
    KillTimer hWnd, 0&
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Das Wort zum Sonntag

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread