VBA in Excel/ XL4-Makros in VBA verwenden

| Hoch zu „Inhaltsverzeichnis“ |

Zum Aufruf von XL4-Makros in VBA

Es gibt Bereiche – beispielsweise das Setzen oder Auslesen der PageSetup-Eigenschaften –, in denen VBA deutliche Performance-Nachteile gegenüber alten XL4-Makros aufzeigt. Zudem bieten XL4-Makros Features, die von den VBA-Entwicklern nicht mehr berücksichtigt wurden. Dazu gehört unter anderem die Möglichkeit, Werte aus geschlossenen Arbeitsmappen auszulesen. Der Aufruf von XL4-Makros ist – wie in den nachfolgenden Prozeduren gezeigt wird – aus VBA heraus möglich. Man beachte die Laufzeitschnelligkeit im Vergleich zu VBA-Makros.

Programmierbeispiele

Tabelle FalseLinks

Auslesen eines Wertes aus geschlossener Arbeitsmappe

Function xl4Value(strParam As String) As Variant    
    xl4Value = ExecuteExcel4Macro(strParam)
End Function  

Sub CallValue()  
   Dim strSource As String   
   strSource = _
      "'" & _
      Range("A2").Text & _ 
      "\[" & Range("B2").Text & _ 
      "]" & Range("C2").Text & _ 
      "'!" & Range("D2").Text 
   MsgBox "Zellwert Zelle A1: " & xl4Value(strSource)
End Sub  


oder:
Sub Zelle_auslesen()
   Dim Adresse As String, Zeile As Integer, Spalte As Integer, Zellbezug As String
   Pfad = "D:\neue Dokumente\"
   Datei = "Urlaub 2009.xls"
   Register = "Kalender"
   Zeile = 14: Spalte = 20 ' entspricht T14
   Zellbezug = Cells(Zeile, Spalte).Address(ReferenceStyle:=xlR1C1)
   
   Adresse = "'" & Pfad & "[" & Datei & "]" & Register & "'!" & Zellbezug

   Ergebnis = ExecuteExcel4Macro(Adresse)
   MsgBox ("Wert der Zelle T14: " & Ergebnis)

End Sub

Auslesen des ANZAHL2-Wertes aus geschlossener Arbeitsmappe

Function xl4CountA(strParam As String) As Variant    
    xl4CountA = _
      ExecuteExcel4Macro("CountA(" & strParam & ")")
End Function  

Sub CallCountA()  
   Dim strSource As String   
   strSource = _
      "'" & _
      Range("A3").Text & _ 
      "\[" & Range("B3").Text & _ 
      "]" & Range("C3").Text & _ 
      "'!" & Range("D3").Text 
   MsgBox "ANZAHL2 in A1:A100: " & xl4CountA(strSource)
End Sub

Auslesen einer Summe aus geschlossener Arbeitsmappe

Function xl4Sum(strParam As String) As Variant    
    xl4Sum = _
      ExecuteExcel4Macro("Sum(" & strParam & ")")
End Function  

Sub CallSum()  
   Dim strSource As String   
   strSource = _
      "'" & _
      Range("A4").Text & _ 
      "\[" & Range("B4").Text & _ 
      "]" & Range("C4").Text & _ 
      "'!" & Range("D4").Text 
   MsgBox "SUMME in A1:B100: " & xl4Sum(strSource)
End Sub

Auslesen eines SVERWEIS-Wertes aus geschlossener Arbeitsmappe

Function xl4VLookup(strParam As String) As Variant    
    xl4VLookup = ExecuteExcel4Macro _
      ("VLookup(""" & Range("E5").Text & _ 
      """, " & strParam & ", " & _
      Range("F5").Text & ", " & _ 
      Range("G5").Text & ")") 
End Function  

Sub CallVLookup()  
   Dim strSource As String   
   strSource = _
      "'" & _
      Range("A5").Text & _ 
      "\[" & Range("B5").Text & _ 
      "]" & Range("C5").Text & _ 
      "'!" & Range("D5").Text 
   MsgBox "SVERWEIS in A1:B100: " & _
      xl4VLookup(strSource)
End Sub

Auslesen einer Tabelle aus geschlossener und Einlesen in neue Arbeitsmappe

Sub ReadTable()  
   Dim wks As Worksheet  
   Dim intRow As Integer, intCol As Integer    
   Dim strSource As String   
   Application.ScreenUpdating = False 
   Set wks = ActiveSheet 
   Workbooks.Add
   For intRow = 1 To 20  
      For intCol = 1 To 2  
         strSource = _
            "'" & _
            wks.Range("A3").Text & _ 
            "\[" & wks.Range("B2").Text & _ 
            "]" & wks.Range("C2").Text & _ 
            "'!R" & intRow & "C" & intCol
         Cells(intRow, intCol).Value = _
            xl4Value(strSource)
      Next intCol 
   Next intRow 
   Application.ScreenUpdating = True 
End Sub

SVERWEIS aus XL4 anwenden

Bei Eingabe eines Suchbegriffes in Spalte A SVERWEIS-Wert in Spalte B eintragen Der Code muss sich im Klassenmodul der Tabelle befinden. Die Daten werden aus der geschlossenen Arbeitsmappe ohne Formeleinsatz ausgelesen.

Private Sub Worksheet_Change(ByVal Target As Range)     
   Dim strSource As String   
   If Target.Column <> 1 Then Exit Sub    
   With Worksheets("FalseLinks")  
      strSource = _
         "'" & _
         .Range("A5").Text & _ 
         "\[" & .Range("B5").Text & _ 
         "]" & .Range("C5").Text & _ 
         "'!" & .Range("D5").Text 
   End With  
   Target.Offset(0, 1).Value = _
      xl4VLookupEvent(strSource, Target.Text)
End Sub  

Private Function xl4VLookupEvent( _  
   strParam As String, _  
   strFind As String) As Variant   
   With Worksheets("FalseLinks")  
      xl4VLookupEvent = _
         ExecuteExcel4Macro("VLookup(""" & strFind & _
         """, " & strParam & ", " & _
         .Range("F5").Text & ", " & _ 
         .Range("G5").Text & ")") 
   End With  
End Function

Namen über XL4 erstellen und ausblenden

Über XL4-Makros können Namen vergeben werden, die über die VBA-Eigenschaft Visible nicht angezeigt und den Befehl Delete nicht gelöscht werden können. Die Namen sind in allen Arbeitsmappen gültig und können als globale Variablen benutzt werden. Ihre Lebensdauer ist abhängig von der Excel-Sitzung. Routine zum Erstellen, Aufrufen und Löschen einer Text-Konstanten:

Sub SetHiddenConst()   
   Dim txt As String   
   txt = InputBox("Bitte beliebige Meldung eingeben:", , _  
      "Dies ist meine konstante Meldung!")
   If txt = "" Then Exit Sub    
   Application.ExecuteExcel4Macro _
      "SET.NAME(""MyMsg"",""" & txt & """)"
End Sub  

Sub GetHiddenConst()   
   On Error Resume Next    
   MsgBox Application.ExecuteExcel4Macro("MyMsg")
   If Err > 0 Then  
      Beep
      Err.Clear
      MsgBox "Es wurde keine Konstante initialisiert!"
   End If  
   On Error GoTo 0     
End Sub  

Sub DeleteHiddenConst()  
   Application.ExecuteExcel4Macro "SET.NAME(""MyMsg"")"
End Sub

Benannte Formel über XL4 anlegen und aufrufen

Routine zum Erstellen, Aufrufen und Löschen der Osterformel.

Sub SetHiddenEastern()  
   Application.ExecuteExcel4Macro _
      "SET.NAME(""OSTERN"",""=FLOOR(DATE(MyYear,3," & _
      "MOD(18.37*MOD(MyYear,19)-6,29)),7)+29"")"
End Sub  

Sub GetHiddenEastern()  
   On Error Resume Next    
   MsgBox Format(Evaluate( _ 
      Application.ExecuteExcel4Macro("OSTERN")), _
      "dd.mm.yyyy")
   If Err > 0 Then  
      Beep
      Err.Clear
      MsgBox "Es wurde kein Ostern initialisiert!"
   End If  
   On Error GoTo 0     
End Sub  

Sub DeleteHiddenEastern() 
   Application.ExecuteExcel4Macro "SET.NAME(""OSTERN"")"
End Sub

Routine zum Erstellen, Aufrufen und Löschen der Kalenderwochen-Formel

Sub SetHiddenKW()  
   Application.ExecuteExcel4Macro _
      "SET.NAME(""DINkw"",""=TRUNC((MyWK-WEEKDAY(MyWK,2)-" & _
      "DATE(YEAR(MyWK+4-WEEKDAY(MyWK,2)),1,-10))/7)"")"
End Sub  

Sub GetHiddenKW()  
   On Error Resume Next    
   MsgBox Evaluate(Application.ExecuteExcel4Macro("DINkw"))
   If Err > 0 Then  
      Beep
      Err.Clear
      MsgBox "Es wurde keine Kalenderwoche initialisiert!"
   End If  
   On Error GoTo 0     
End Sub  

Sub DeleteHiddenKW() 
   Application.ExecuteExcel4Macro "SET.NAME(""DINkw"")"
End Sub

Druckprogrammierung über XL4-Makros

Wesentliche Geschwindigkeitsvorteile werden erreicht, wenn XL4-Makros beim Auslesen oder beim Setzen von PageSetup-Eigenschaften eingesetzt werden.

Auslesen der Seitenzahl des aktiven Blattes

Sub PageCountActiveSheet() 
   MsgBox "Seitenanzahl: " & _
      ExecuteExcel4Macro("GET.DOCUMENT(50)")
End Sub

Auslesen der Seitenanzahl eines anderen Blattes

Sub PageCountOtherSheet() 
   MsgBox "Seitenanzahl: " & _
      ExecuteExcel4Macro("Get.document(50,""DeleteRows"")") 
End Sub

Auslesen der Seitenanzahl eines Blattes in einer anderen Arbeitsmappe

Sub PageCountOtherWkb() 
   Dim wkb As Workbook  
   On Error Resume Next    
   Set wkb = Workbooks("Test.xls") 
   If Err > 0 Or wkb Is Nothing Then     
      Beep
      MsgBox "Es muss eine Arbeitsmappe ""Test.xls"" geöffnet sein!"
      Exit Sub  
   End If  
   MsgBox "Seitenanzahl: " & _
      ExecuteExcel4Macro("Get.document(50,""[Test.xls]Tabelle1"")") 
End Sub

Setzen von Druckeigenschaften wie Schriftgröße, Schriftart u.ä.

Sub SetPageSetup()  
   ExecuteExcel4Macro _
      "PAGE.SETUP("""",""&L&""""Arial,Bold""""&" & _
      "8MeineFirma GmbH & Co. KG&R&""""Arial,Bold""""&8&F," & _
      "&D,Seite 1"",0.75,0.75,0.91,0.5,FALSE,FALSE,TRUE,FALSE" & _
      ",2,1,95,#N/A,1,TRUE,,0.75,0.25,FALSE,FALSE)"
End Sub

Auslesen aller horizontalen und vertikalen Seitenumbrüche

Sub GetPageBreaks()  
   Dim horzpbArray() As Integer    
   Dim verpbArray() As Integer    
   Dim intCounter As Integer, intCol As Integer, intRow As Integer    
   ThisWorkbook.Names.Add Name:="hzPB", _
      RefersToR1C1:="=GET.DOCUMENT(64,""PrintPages"")"  
   ThisWorkbook.Names.Add Name:="vPB", _
      RefersToR1C1:="=GET.DOCUMENT(65,""PrintPages"")"  
   intCounter = 1
   While Not IsError(Evaluate("Index(hzPB," & intCounter & ")"))     
      ReDim Preserve horzpbArray(1 To intCounter)    
      horzpbArray(intCounter) = Evaluate("Index(hzPB," & intCounter & ")") 
      intCounter = intCounter + 1
   Wend 
   ReDim Preserve horzpbArray(1 To intCounter - 1)    
   intCounter = 1
   While Not IsError(Evaluate("Index(vPB," & intCounter & ")"))     
      ReDim Preserve verpbArray(1 To intCounter)    
      verpbArray(intCounter) = Evaluate("Index(vPB," & intCounter & ")") 
      intCounter = intCounter + 1
   Wend 
   ReDim Preserve verpbArray(1 To intCounter - 1)    
   Workbooks.Add
   With Range("A1")  
      .Value = "Horizontale Seitenumbrüche (Zeilen):"
      .Font.Bold = True 
   End With  
   For intRow = LBound(horzpbArray, 1) To UBound(horzpbArray, 1)  
      Cells(intRow + 1, 1) = horzpbArray(intRow)
   Next intRow 
   With Range("B1")  
      .Value = "Vertikale Seitenumbrüche (Spalten):"
      .Font.Bold = True 
   End With  
   For intCol = LBound(verpbArray, 1) To UBound(verpbArray, 1)  
      Cells(intCol + 1, 2) = verpbArray(intCol)
   Next intCol 
   Columns.AutoFit
   Columns("A:B").HorizontalAlignment = xlCenter
End Sub

Schließen der Arbeitsmappe verhindern

In den Excel-Versionen ab XL8 kann über das Workbook_BeforeClose-Ereignis das Schließen der Arbeitsmappe verhindert werden. Dieses Ereignis steht bei der Vorgängerversionen nicht zur Verfügung. Wenn also eine Arbeitsmappe abwärtskompatibel sein soll, kann hier ein XL4-Makro eingesetzt werden.

Sub auto_close() 
   If Worksheets("NoClose").CheckBoxes _  
      ("chbClose").Value = xlOn Then   
      ExecuteExcel4Macro "HALT(TRUE)"
      MsgBox "Das Schließen der Arbeitsmappe " & _
         "ist gesperrt -" & vbLf & _
         "Bitte zuerst die Sperre im " & _
         "Blatt ""NoClose"" aufheben!" 
   End If  
End Sub

Arbeitsblattmenüleiste zurücksetzen

Über Schaltfläche kann die Arbeitsblattmenüleiste zurückgesetzt und die letzte Einstellung wieder gesetzt werden

Sub MenuBar() 
   With ActiveSheet.Buttons(1) 
      If .Caption = "Menüleiste Reset" Then  
         ExecuteExcel4Macro "SHOW.BAR(2)"
         .Caption = "Menüleiste zurück"
      Else 
         ExecuteExcel4Macro "SHOW.BAR(1)"
         .Caption = "Menüleiste Reset"
      End If  
   End With  
End Sub

Bedingtes Löschen von Zeilen

Das Löschen von Zeilen nach bestimmten Kriterien kann in VBA eine zeitwaufwendige Aufgabe sein, mit XL4-Makros ist das vergleichsweise schnell und einfach zu lösen

Sub DeleteRows() 
   Dim rngAll As Range, rngCriteria As Range   
   Application.ScreenUpdating = False 
   Set rngAll = Range("A1").CurrentRegion  
   rngAll.Name = "'" & ActiveSheet.Name & "'!Datenbank"
   Set rngCriteria = rngAll.Resize(2, 1).Offset _ 
      (0, rngAll.Columns.Count + 1)
   With rngCriteria 
      .Name = "'" & ActiveSheet.Name & _
         "'!Suchkriterien"
      .Cells(1, 1).Value = "Name"
      .Cells(2, 1).Formula = "'<>Hans W. Herber" 
      ExecuteExcel4Macro "DATA.DELETE()"
      .Clear
   End With  
   Application.ScreenUpdating = True 
End Sub

| Hoch zu „Inhaltsverzeichnis“ |