Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Inhalt dieser Seite

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

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

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

Druckprobrammierung ü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 andere 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