VBA in Excel


Hans W. Herber
Wikibooks


Namenskonventionen

Bearbeiten


Wozu Namenskonventionen?

Bearbeiten

Namenskonventionen sind freiwillige Vereinbarungen von Programmierern, die ein bestimmtes System für die Vergabe von Bezeichnern für Objekte, Variablen und Konstanten einführen, damit anhand der Namen sofort Rückschlüsse auf den Verwendungszweck im Programm gezogen werden können. Eine einheitliche Form der Namensgebung für Variablen, Konstanten und anderer VBA-Komponenten erleichtert es zum einen Entwicklern, den Code des anderen zu verstehen. Zum anderen findet man sich bei einer disziplinierten Namensvergabe auch in seinem eigenen Code besser zurecht. Gänzlich unerlässlich ist die Vereinbarung, wenn ein VBA-Programm im Team erstellt wird.

Die Bestandteile eines Namens

Bearbeiten

Der Name besteht aus 3 Teilen: Präfix, Art und Benennung. Der einzige nicht optionale Bestandteil ist die Art. Da sich jedoch in der Regel mehrere Elemente einer Art im Code befinden, wird – um diese unterscheiden zu können – eine Benennung notwendig:

[präfix]Art[Benennung]

Die eckigen Klammern weisen darauf hin, dass es sich bei den Inhalten um optionale Elemente handelt. Die Klammern selbst sind kein Bestandteil des Namens.

Hier drei Beispiele:

Name Präfix Art Benennung
wksKunden   wks Kunden
mintTeileNo m int TeileNo
gstrKundName g str KundName

Präfix und Art werden in Kleinbuchstaben geschrieben, das erste Zeichen der Benennung als Großbuchstabe. Dies erleichtert die Lesbarkeit des Namens und lenkt den Blick auf die Benennung. In der Benennung selbst wird im Sinne der besseren Lesbarkeit der erste Buchstabe eines jeden Wortes groß geschrieben. Im Sinne der Internationalisierung des VBA-Codes sind generell in den Namen keine Umlaute oder das ß einzusetzen.

Das Präfix

Das Präfix gibt die Art und Gültigkeit der Variablen oder Konstanten an. Hierfür gelten folgende Festlegungen:

  • In Subs oder Functions deklarierte Variablen erhalten kein Präfix
  • Lokal als Static deklarierte Variablen oder Konstanten erhalten das Präfix s, also beispielsweise sintCounter
  • Variablen, die im Deklarationsteil eines Moduls mit einer Dim oder Private-Anweisung deklariert wurden, erhalten das Präfix m, also beispielsweise mcurSumme
  • Global außerhalb von Subs oder Funktionen deklarierte Variablen erhalten das Präfix g, also beispielsweise gdblGesamtSumme

Die Art

Hier wird die Art der Variablen festgelegt.

Die Excel-Blätter:

BlattArtBeispiel
ArbeitsblattwkswksKunde
DiagrammchtchtVerkaeufe
UserForm (XL97/2000) Dialogblatt (XL5/7)frmfrmRechnungHilfe
StandardmodulebasbasMain
KlassenmoduleclsclsMsg
Excel-4-Makro-Blattxl4xl4Bestellung

Die Variablentypen

Bearbeiten
VariablentypArtBeispiel
BooleanblnDim blnSchalter as Boolean
CurrencycurDim curBetrag As Currency
DatedatDim datStartDatum As Date
DoubledblDim dblPi as Double
IntegerintDim intCounter as Integer
LonglngDim lngParam as Long
ObjectobjDim objGraph as Object
SinglesngDim sngParam as Single
StringstrDim strUserName as String
Type (benutzerdefiniert)typDim typPartRecord As mtPART_RECORD
VariantvarDim varEingabe as Variant

Zur Deklaration von Variablen siehe Abschnitt Variablen und Arrays

Bei Objektlisten wird der Art ein s hinzugefügt. Beispiele:

  • Workbook = wkb - Workbooks = wkbs
  • Chart = cht - Charts = chts

Die MS-Forms-Elemente

Bearbeiten
Objekt Art Beispiel
Label lbl lblHelpMessage
TextBox txt txtLoginName
ComboBox cbo cboMonate
ListBox lst lstAufstellung
CheckBox chk chkAnlage
OptionButton opt optJa
ToggleButton tgl tglSchalter
CommandButton cmd cmdWeiter
TabStrip tab tabTexte
MultiPage mpg mpgKalender
SpinButton spn spnZaehler
ScrollBar scr scrLeiste
Image img imgStart
RefEdit ref refBereich
TreeView trv trvVerteilung
ListView lsv lsvOrdner
Calendar cal calAktuell
Frame fra fraFolderGroup

Die Konstanten und benutzerdefinierten Typen

Bearbeiten

Bei den Konstanten weicht man bei VBA von der sonst üblichen Form Großbuchstaben/Unterstriche (Bsp.=NO_WORKSHEET_ERROR) ab. Die Art der Konstanten wird mit con festgelegt, dem möglicherweise ein Präfix (siehe oben) vorangestellt wird. Für die Benennung gelten die oben getroffenen Festlegungen.

Beispiel: gconFalscherDatenTyp

Benutzerdefinierte Typen werden mit einem dem Präfix folgenden t kenntlich gemacht, dem dIe Benennung gemäß den weiter oben gemachten Regeln folgt. Die Benennung erfolgt hier in Großbuchstaben, wobei die einzelnen Wörter durch Unterstriche getrennt werden.

Beispiel: mtPART_RECORD

Die Sprungmarken

Bearbeiten

Die festgelegten Regeln für die Namenskonvention von Sprungmarken werden hier nicht übernommen, da eine moderne Excel-Programmierung ohne Sprungmarken auskommt. Hier gibt es allerdings eine Ausnahme: Die Fehler-Programmierung bei auffangbaren Fehlern. Da es die einzige in einer Prozedur vorkommende Sprungmarke ist, bedarf sie keiner besonderen Kennzeichnung. Ihr Name ist im allgemeinen ErrorHandler

Prozeduren und Funktionen

Bearbeiten

Für die Prozedur- und Funktionsnamen gibt es – mit Ausnahme der Ereignisprozeduren – keine Regeln. Im Interesse einer guten Lesbarkeit und schnellen Abarbeitung des Codes sollte die Länge 20 Zeichen nicht überschreiten. Sie sollten beschreibend und erklärend sein. Jedes Wort beginnt mit einem Großbuchstaben. Gebräuchlich sind die Wortpaare Verb/Gegenstandswort.

Beispiele: AufrufenDialog, SortierenMatrix, WechselnBlatt

Wenn Sie Ereignisse in XL97/2000 programmieren, werden die Prozedurnamen vom VBE festgelegt und sie haben keinen Einfluss darauf. Ausnahmen bilden benutzerdefinierte Ereignisse und Ereignisse zu Elementen, die nicht zu MSForms gehören. Verwenden Sie hier einen beschreibenden Namen, dem ein Unterstrich und ein Hinweis auf die Art des Ereignisses folgt.

Kommentare

Bearbeiten

Die Kommentierung des VBA-Codes wird oft vernachlässigt, ist jedoch eine Notwendigkeit. Sie erfordert einen erheblichen Einsatz von Zeit und Energie. Zum einen sollte ein Dritter die Möglichkeit haben, das Programm zu verstehen, zum anderen wird man selbst – wenn man nach einem Jahr erneut in den Code einsteigen muss – froh über jede Information sein.

Wichtige Elemente des Kommentars sind die Angabe des Autors, des Erstellungs- und letzten Änderungsdatums. Im Weiteren ist die Kommentierungstechnik abhängig von der Art des Code-Aufbaus.

Visual-Basic-Editor

Bearbeiten


Der Editor

Bearbeiten

Der Visual-Basic-Editor stellt die Entwicklungsumgebung für die VBA-Programmierung dar. Sie gelangen zum Editor mit der Tastenkombination Alt+F11. Im linken Teil des Fensters sehen Sie den Projekt-Explorer mit den zur Zeit geöffneten Projekten, also Arbeitsmappen und AddIns.

Die Einstellungen

Bearbeiten

Über das Menü Extras / Optionen können Sie Einstellungen für die Arbeit mit dem Editor vornehmen. Hier einige Empfehlungen:

  • Register Editor
    Aktivieren Sie alle Kontrollkästchen mit Ausnahme des ersten (Automatische Syntaxüberprüfung, mehr störend als sinnvoll). Wichtig ist die Aktivierung von Variablendeklaration erforderlich. Dies zwingt Sie zu einer zumindest ansatzweise ordentlichen Variablendeklaration.
  • Register Editierformat
    Verändern Sie hier nur dann die Voreinstellungen, wenn außer Ihnen niemand in der Entwicklungsumgebung arbeitet, andernfalls wirken sich die Änderungen für Dritte störend aus.
  • Register Allgemein
    Im Rahmen Unterbrechen bei Fehlern sollte die Option Bei nicht verarbeiteten Fehlern aktiviert sein. Andernfalls kann es im Rahmen von Fehlerroutinen zu unerwarteten Programmabbrüchen kommen.
  • Register Verankern
    Es sollten alle Kontrollkästchen mit Ausnahme des letzten (Objektkatalog) aktiviert sein.

Die Elemente

Bearbeiten

Als Programmierelemente (Container für Ihre Programmierungen) stehen Ihnen zur Verfügung:

  • UserForm
    Ein programmierbarer Dialog mit einer Anzahl von eingebauten und anderen, integrierbaren Steuerelementen.
  • Modul (Standardmodul)
    Hier gehören die Prozeduren mit Ausnahme der Ereignisprogrammierung hinein.
  • Neues Klassenmodul
    Es können neue Klassen gebildet werden.
  • Klassenmodule der Objekte der Arbeitsmappe; diese Module stellen die Container für die Ereignisprogrammierung dar. Dabei handelt es sich um:
    • Diese Arbeitsmappe
    • Tabelle1 etc.
    • evtl. vorhandene UserForms

Der Objektkatalog

Bearbeiten

Über den Objektkatalog (aufzurufen mit F2) erhalten Sie eine schnelle Übersicht über die Klassen der Bibliotheken und deren Elemente. Wenn Sie eine Klasse oder ein Element markieren, erhalten Sie mit F1 die zugehörige Hilfedatei.

Prozeduren

Bearbeiten


Begriffsbestimmung, Deklaration und Parameter

Bearbeiten

In VBA ist Prozedur der Oberbegriff für Funktionen und Unterprogramme.

Durch die Deklaration zu Beginn der Prozedur wird bestimmt, von welchen anderen Prozeduren sie aufgerufen werden kann. Sie kann erfolgen als:

  • Public
    Auf eine solche Prozedur kann von allen anderen Prozeduren in allen Modulen zugegriffen werden. Bei Verwendung in einem Modul (mit einer Option Private-Anweisung) kann auf die Prozedur nur innerhalb des Projekts zugegriffen werden.
  • Private
    Auf eine solche Prozedur kann nur durch andere Prozeduren aus dem Modul zugegriffen werden, in dem sie deklariert wurde.
  • Static
    Die lokalen Variablen einer solchen Prozedur bleiben zwischen Aufrufen erhalten. Das Attribut Static wirkt sich nicht auf Variablen aus, die außerhalb der Prozedur deklariert wurden, auch wenn sie in der Prozedur verwendet werden.

Die Voreinstellung ist Public.

Die Festlegung der Parameter kann erfolgen als:

  • Optional
    Schlüsselwort, das angibt, dass ein Argument nicht erforderlich ist. Alle im Anschluss an Optional in der Argumentenliste angegebenen Argumente müssen auch optional sein und mit dem Schlüsselwort Optional deklariert werden. Optional kann nicht verwendet werden, wenn ParamArray verwendet wird.
  • ByVal
    Das Argument wird als Wert übergeben. Siehe auch: ByRef und ByVal bei Variablen
  • ByRef
    Das Argument wird als Referenz übergeben.
  • ParamArray
    Ist nur als letztes Argument in ArgListe zulässig und gibt an, dass das letzte Element ein als Optional deklariertes Datenfeld mit Variant-Elementen ist. Das Schlüsselwort ParamArray erlaubt die Angabe einer variablen Anzahl von Argumenten und darf nicht in Kombination mit den Schlüsselwörtern ByVal, ByRef oder Optional verwendet werden.

Benutzerdefinierte Funktionen (UDF)

Bearbeiten

Weitere Informationen: VBA in Excel/ Funktionen

Funktionen werden mit oder ohne Parameter aufgerufen und geben Werte zurück. Der Aufruf kann sowohl über andere Funktionen oder Prozeduren als auch über die Eingabe im Arbeitsblatt erfolgen. Sie kann Excel- und VBA-Funktionen integrieren.

Beispiel für eine Funktion:

Function Ostern(iYear As Integer)
   Dim iDay As Integer
   iDay = (((255 - 11 * (iYear Mod 19)) - 21) Mod 30) + 21
   Ostern = DateSerial(iYear, 3, 1) + iDay + (iDay > 48) + _
      6 - ((iYear + iYear \ 4 + iDay + (iDay > 48) + 1) Mod 7)
End Function

Beispiel für den Aufruf aus einer Prozedur heraus:

Sub WannIstOstern()
   MsgBox "Ostersonntag: " & Ostern(2008)
End Sub


Im Arbeitsblatt kann die Funktion durch folgende Eingabe verwendet werden (Jahreszahl in Zelle A1):

=ostern(A1)


Wichtig: Wenn eine Funktion aus dem Tabellenblatt heraus aufgerufen wird, kann sie bestimmte VBA-Aktionen, z.B. Blattwechsel, nicht ausführen.

Unterprogramm (Sub)

Bearbeiten

Ein Unterprogramm wird mit oder ohne Parameter aufgerufen und gibt keine Werte zurück, kann aber übergebene Variablenwerte verändern. Der Aufruf erfolgt durch andere Prozeduren, nicht jedoch über eine Eingabe im Arbeitsblatt. Sie können Excel- und VBA-Funktionen integrieren.

Wie in anderen BASIC-Dialekten wird ein Unterprogramm durch das Schlüsselwort SUB gekennzeichnet. Es hat sich deshalb auch der Begriff Sub (Mehrzahl: Subs) eingebürgert.

Beispiel einer Prozedur mit dem Aufruf eines Unterprogramms:

Sub WertEintragen()
   Dim datStart As Date, datEnd As Date
   Dim iTage As Integer
   datStart = DateSerial(Year(Date), 2, 15)
   datEnd = DateSerial(Year(Date), 12, 11)
   Call WertErmitteln(datStart, datEnd, iTage)
   Range("A1").Value = iTage
End Sub

Sub WertErmitteln(ByVal datStart, ByVal datEnde, ByRef iDiff As Integer)
   iDiff = datEnde - datStart
End Sub

Informationen über ByRef/ByVal: VBA in Excel/ ByRef und ByVal

Wann sind Funktionen und wann sind Subs einzusetzen?

Bearbeiten

Verwenden Sie Funktionen immer dann, wenn Sie ein Ergebnis in Tabellenblättern als Formel einsetzen möchten oder wenn Sie aus einer Sub heraus Rückgabewerte anfordern möchten. In allen anderen Fällen sollten Sie sich für Subs entscheiden.

Funktionen

Bearbeiten


Arten der Funktionen

Bearbeiten

Bestandteil fast jeder – auch einfachsten – Programmierung sind Funktionen. Bei der Excel-/VBA-Programmierung hat man es mit 3 Gruppen von Funktionen zu tun:

  • Excel-Funktionen
  • VBA-Funktionen
  • benutzerdefinierte Funktionen (UDF)

Einsatz von Excel-Funktionen

Bearbeiten

Funktionen erwarten in der Regel Übergabewerte, auf deren Grundlage sie ihre Berechnungen durchführen und geben die Berechnungsergebnisse zurück. Sie können grundsätzlich sowohl innerhalb von VBA-Programmen verwendet wie auch in Tabellenblättern eingesetzt werden, wobei beim Einsatz von benutzerdefinierten Funktionen in Tabellenblättern Beschränkungen zu beachten sind.

Eine Reihe von Funktionen gibt es sowohl in Excel als auch in VBA. Bei der Wahl des Einsatzes der einen oder anderen muss beachtet werden, dass gleichlautende Excel/VBA-Funktionen zu durchaus unterschiedlichen Ergebnissen führen können. Hier sei exemplarisch auf die Trim-Funktion hingewiesen, die in VBA Leerzeichen am Anfang und Ende einer Zeichenfolge, bei Excel zusätzlich die überzähligen innerhalb eines Strings entfernt.

Grundsätzlich gilt für alle Funktionen, ob eingebaute, über VBA einzutragende oder benutzerdefinierte, dass sie keine Formatierungen transportieren können. Über Funktionen, die im Tabellenblatt aufgerufen werden, können Sie beispielsweise keine Hintergrundformate oder Schriftattribute festlegen, dazu benötigen Sie eine Sub. Jedoch können Funktionen, die über den VBA Editor ausgeführt werden, solche Änderungen vornehmen.

Verwendung innerhalb von VBA-Prozeduren

Bearbeiten

Excel-Funktionen müssen in VBA als solche kenntlich gemacht werden, indem man ihnen entweder ein Application oder ein Worksheetfunction voranstellt. Soll die Arbeitsmappe abwärtskompatibel angelegt werden, ist Application zu verwenden, da die Vorgängerversionen (vor Excel 2000) kein Worksheetfunction kennen. Allgemein ist die Verwendung von Worksheetfunction zu empfehlen, da bei deren Einsatz zum einen die Elemente (Funktionen) automatisch aufgelistet werden und zum anderen als weitere Unterstützung die jeweilige Argumentenliste angezeigt wird.

Von diesem Prinzip sollte abgewichen werden, wenn beim Rückgabewert der Funktion Fehlerwerte zu erwarten sind. Worksheetfunction liefert statt des Fehlerwertes den beliebten, zum Programmabbruch führenden Laufzeitfehler 1004.

So funktioniert es nicht:

Function IsExistsA(strTxt As String) As Boolean     
   Dim var As Variant   
   var = WorksheetFunction.Match(strTxt, Columns(1), 0) 
   If Not IsError(var) Then IsExistsA = True      
End Function

Die Notwendigkeit des Abfangens des Fehlers kann man sich ersparen, indem man statt Worksheetfunction jetzt Application verwendet:

Function IsExistsB(strTxt As String) As Boolean     
   Dim var As Variant   
   var = Application.Match(strTxt, Columns(1), 0)
   If Not IsError(var) Then IsExistsB = True      
End Function

Verwendung im Arbeitsblatt

Bearbeiten

Sie haben die Möglichkeit, Excel-Funktionen oder deren Ergebnisse in einem Arbeitsblatt eintragen zu lassen. Sinnvollerweise werden die Funktionen (Formeln) dann eingetragen, wenn spätere Wertekorrekturen im zu berechnenden Bereich zu einer Neuberechnung in der Ergebniszelle führen sollen.

Hinweis: Wenn Range-Objekte (Range, Cells, Rows, Columns, Areas) nicht explizit auf ein Worksheet-Objekt angewendet werden (so z.B. als Worksheet("Tabelle 1").Range), bezieht Excel auf das aktive, sichtbare Arbeitsblatt (ActiveSheet), VBA liest also die Anweisung Cells(1,1) bzw. Range("A1") immer als ActiveSheet.Cells(1,1) bzw. ActiveSheet.Range("A1").

Nur mit einem Workbook-Objekt als Präfix kann auch auf inaktive, ausgeblendeten oder versteckten Tabellenblättern gearbeitet werden.

Der Eintrag eines absoluten Wertes (Summe des Wertebereiches in Spalte A):

Sub SumValue() 
   Dim intRow As Integer    
   intRow = Cells(Rows.Count, 1).End(xlUp).Row 
   Cells(intRow + 1, 1).Value = WorksheetFunction.Sum(Range("A1:A" & intRow))  
End Sub

Der Eintrag einer Formel (Summe des Wertebereiches in Spalte A):

Sub SumFormula()  
   Dim intRow As Integer    
   intRow = Cells(Rows.Count, 1).End(xlUp).Row 
   Cells(intRow + 1, 1).Formula = "=Sum(A1:A" & intRow & ")" 
End Sub

Für den Formeleintrag bieten sich folgende Möglichkeiten:

Die Formel wird in englischer Schreibweise eingetragen und umfasst einen absoluten Bereich:

Sub AbsoluteFormel()  
   Range("B1").Formula = "=AVERAGE(A1:A20)"  
End Sub

FormulaR1C1

Bearbeiten

Die Formel wird in englischer Schreibweise eingetragen und umfasst einen relativen Bereich:

Sub RelativeFormelA()  
   Range("B2").Select  
   Range("B2").FormulaR1C1 = "=AVERAGE(R[-1]C[-1]:R[18]C[-1])"  
End Sub

Sie kann auch einen teils absoluten und teils relativen Bereich umfassen:

Sub RelativeFormelB()  
   Range("C2").Select  
   Range("C2").FormulaR1C1 = "=AVERAGE(R1C[-1]:R20C[-1])"  
End Sub

Lokale Formeln

Bearbeiten

Bei FormulaLocal und FormulaR1C1Local wird die Formel wird entsprechend der Spracheinstellung des Betriebssystems eingetragen, in den folgenden Beispielen ist das die deutsche Sprache. Wird eine solche Arbeitsmappe auf einem Excel mit französischer Spracheinstellung ausgeführt, kann es zu Fehlern und unerwarteten Ergebnissen kommen.

Berücksichtigen Sie auch, dass sich die Präfixe für Zeilen/Spalten sowie den Austausch der eckigen gegen die runden Klammern der Sprachauswahl angepasst haben: R → Z, C → S, [] → ().

FormulaLocal
Bearbeiten

Hier umfasst die Formel einen absoluten Bereich:

Sub AbsoluteFormelLocal()  
   Range("B1").FormulaLocal = "=MITTELWERT(A1:A20)"  
End Sub
FormulaR1C1Local
Bearbeiten

Die Formel umfasst einen relativen Bereich:

Sub RelativeFormelALocal()  
   Range("B2").Select  
   Range("B2").FormulaR1C1Local = "=MITTELWERT(Z(-1)S(-1):Z(18)S(-1))"  
End Sub

Sie kann auch einen teils absoluten und teils relativen Bereich umfassen:

Sub RelativeFormelBLocal()  
   Range("C2").Select  
   Range("C2").FormulaR1C1Local = "=MITTELWERT(Z1S(-1):Z20S(-1))"  
End Sub


FormulaArray

Bearbeiten

Array-Formeln werden ohne die ihnen eigenen geschweiften Klammern eingegeben. Eine FormulaLocal-Entsprechung gibt es hier nicht.

Sub ArrayFormel()  
   Range("B3").FormulaArray = _  
      "=SUM((D16:D19=""Hosen"")*(E16:E19=""rot"")*F16:F19)"
End Sub

Dem FormulaArray-Befehl kommt einige Bedeutung zu, da Array-Berechnungen in VBA ihre Zeit benötigen und es sich in vielen Fällen empfiehlt, temporäre ArrayFormeln in Zellen eintragen zu lassen, um ihre Werte auszulesen.

Einsatz von VBA-Funktionen

Bearbeiten

Verwendung innerhalb von VBA-Prozeduren

Bearbeiten

Beim Einsatz von VBA-Funktionen ist bei geforderter Abwärtskompatibilität Vorsicht geboten. Während die Anzahl der Excel-Formeln seit Jahren im Wesentlichen konstant geblieben ist, trifft dies für VBA-Funktionen nicht zu. Im Interesse eines möglichst weitverbreiteten VBA-Einsatzes wird die Palette der VBA-Funktionen gelegentlich erweitert.

Der Aufruf einer VBA-Funktion ist einfachst; hier wird das aktuelle Verzeichnis geliefert:

Sub PathAct() 
   MsgBox CurDir
End Sub

Verlangt die Funktion Parameter, erfolgt der Aufruf mit der Parameterübergabe:

Sub TypeAct() 
   MsgBox TypeName(ActiveSheet)
End Sub

Verwendung im Arbeitsblatt

Bearbeiten

Ergebnisse von VBA-Funktionen können über den Aufruf in benutzerdefinierten Funktionen auch direkt ins Tabellenblatt eingetragen werden:

Function UmgebungsVariable() 
   UmgebungsVariable = Environ("Path")
End Function

Einsatz von benutzerdefinierten Funktionen (UDF)

Bearbeiten

Verwendung innerhalb von VBA-Prozeduren

Bearbeiten

Benutzerdefinierte Funktionen werden in aller Regel dann eingesetzt, wenn mehrfach wiederkehrende Berechnungen durchgeführt werden sollen. Wenn es denn auch nicht verlangt wird, sollten sowohl die Funktionen selbst, deren Parameter sowie die in den Funktionen verwendeten Variablen sauber dimensioniert werden.

Im folgenden Beispiel wird aus einer Prozedur heraus mehrfach eine Funktion zum Gesperrtschreiben der Ortsnamen aufgerufen:

Sub PLZundOrt()  
   Dim intRow As Integer    
   intRow = 1
   Do Until IsEmpty(Cells(intRow, 1))   
      Cells(intRow, 3) = Cells(intRow, 1) & " " & _
         Gesperrt(Cells(intRow, 2))
      intRow = intRow + 1
   Loop 
End Sub  

Function Gesperrt(strOrt As String) As String    
   Dim intCounter As Integer    
   Do Until Len(strOrt) > 10   
      For intCounter = Len(strOrt) - 1 To 1 Step -1   
         If Mid(strOrt, intCounter, 1) <> " " Then   
            strOrt = Left(strOrt, intCounter) & " " & _ 
               Right(strOrt, Len(strOrt) - intCounter) 
         End If  
      Next intCounter 
   Loop 
   Gesperrt = strOrt 
End Function

Hier wird eine benutzerdefinierte Funktion zur Umrechnung von Uhrzeiten in Industriezeiten unter Berücksichtigung einer Pausenzeit eingesetzt:

Sub DateToNumber()  
   Dim intRow As Integer    
   intRow = 10
   Do Until IsEmpty(Cells(intRow, 1))   
      Cells(intRow, 2) = IndustrieZeit(Cells(intRow, 1)) 
      intRow = intRow + 1
   Loop 
End Sub  

Function IndustrieZeit(dat As Date) As Double      
   Dim dblValue As Double    
   dblValue = dat * 24
   IndustrieZeit = dblValue - 0.25 
End Function

Verwendung im Arbeitsblatt

Bearbeiten

Dimensionieren Sie die Funktions-Parameter entsprechend dem übergebenen Wert, nicht nach dem Range-Objekt, aus dem der Wert übergeben wird. Dies gilt unabhängig davon, ob die Range-Dimensionierung im aktuellen Fall ebenfalls richtige Ergebnisse zuläßt. Vorstehendes gilt selbstverständlich nicht für zu übergebende Matrizen (Arrays). Im Falle einer evtl. notwendigen Abwärtskompatibilität ist zu beachten, dass die Vorgängerversionen von Excel 8.0 (97) das Range-Objekt in der Parameter-Dimensionierung nicht akzeptieren; verwenden Sie hier das Object-Objekt.

Selbstverständlich lässt sich über Funktionen keine Cursor auf Reisen schicken, jegliches Selektieren entfällt. In Excel 5.0 und 7.0 ist es zudem auch nicht möglich, simulierte Richtungstastenbewegungen einzusetzen. Der nachfolgende Code führt dort zu einem Fehler:

Function GetLastCellValueA(intCol As Integer) As Double       
   Dim intRow As Integer    
   intRow = Cells(Rows.Count, intCol).End(xlUp).Row 
   GetLastCellValueA = Cells(intRow, intCol).Value 
End Function

In diesen Versionen müssen die Zellen abgeprüft werden, wobei man von UsedRange als Ausgangsposition ausgehen kann:

Function GetLastCellValueB(intCol As Integer) As Double       
   Dim intRow As Integer, intRowL As Integer    
   intRowL = ActiveSheet.UsedRange.Rows.Count 
   For intRow = intRowL To 1 Step -1  
      If Not IsEmpty(Cells(intRow, intCol)) Then Exit For      
   Next intRow 
   GetLastCellValueB = Cells(intRow, intCol).Value 
End Function

Der Versuch, einen gesuchten und gefundenen Zellwert an eine Funktion zu übergeben, führt bei Excel 8.0 und höher zu einem falschen Ergebnis (Leerstring) und bei den Vorgängerversionen zu einem Fehler:

Function GetFindCellValue(intCol As Integer, strTxt As String) As String      
   Dim rngFind As Range   
   Set rngFind = Columns(intCol).Find(strTxt, lookat:=xlWhole, LookIn:=xlValues)  
   If Not rngFind Is Nothing Then GetFindCellValue = rngFind.Value     
End Function

Beachten Sie bitte, dass das in diesem Abschnitt geschriebene sich ausschließlich auf benutzerdefinierte Funktionen bezieht, die in ein Tabellenblatt eingetragen werden.

Unter Umständen muss die Adresse der aufrufenden Zelle den Ausgangspunkt für die in der benutzerdefinierten Funktion ablaufenden Berechnungen bilden. Nur beim Eingabezeitpunkt richtige Ergebnisse bringt hier die Festlegung mit ActiveCell, denn bei irgendeiner Eingabe in eine andere Zelle ist dies die aktive Zelle.

Falsche Verankerung:

Function MyValueA(intOffset As Integer) As Variant     
   Application.Volatile
   MyValueA = ActiveCell.Offset(0, intOffset).Value
End Function

Richtige Verankerung:

Function MyValueB(intOffset As Integer) As Variant     
   Application.Volatile
   MyValueB = Application.Caller.Offset(0, intOffset).Value 
End Function

Die korrekte Zuweisung erfolgt über Application.Caller.

Benutzerdefinierte Funktionen berechnen sich auch bei eingeschaltete automatischer Berechnung nicht von selbst. Wünscht man eine Berechnung bei jeder Zelleingabe, ist den Funktionen ein Application.Volatile voranzustellen. Mit dieser Anweisung sollte vorsichtig umgegangen werden, denn sie kann Berechnungsabläufe extrem verzögern. In Arbeitsmappen, mit denen ständig abrufbare Funktionen bereitgestellt werden - bspw. in der Personl.xls - ist sie konsequent zu meiden.

Übergabe von Bereichen

Bearbeiten

In benutzerdefinierten Funktionen können -neben Werten- auch ein oder mehrere Zellbereiche übergeben werden. So wie man z.B. der eingebauten Funktion =SUMME(D1:D33) mit D1:D33 einen Bereich übergibt, so kann auch einer Benutzerdefinierten Funktion ein Bereich übergeben werden.

Der Variable für einen Bereich (in den Beispielen wird die Variable oft Bereich genannt) kann nur als Typ Range festgelegt werden, es gibt zwar die Auflistungen Cells, Rows, Columns und Areas, aber die listen keine eigenen Objekte auf, sondern immer nur ein Range-Objekt.

Das folgende Beispiel zeigt eine Funktion, die einen Bereich als Argument entgegen nimmt und die Beträge des angegebenen Bereichs aufsummiert:

Public Function SummeBetrag(Bereich As Excel.Range) As Double
    Dim Zelle As Excel.Range
    For Each Zelle In Bereich.Cells
        ' Enthält die Zelle eine Zahl?
        If IsNumeric(Zelle.Value) Then
            ' Nur bearbeiten, falls Zahl:
            SummeBetrag = SummeBetrag + Abs(Zelle.Value)
        End If
    Next Zelle
End Function

Die For Each Schleife geht dabei den markierten Bereich von links nach rechts und dann von oben nach unten durch. Wäre der Bereich A1:B2 markiert worden, würde die Summe in der Reihenfolge A1 + B1 + A2 + B2 berechnet.

Manchmal möchte man einen Bereich spaltenweise durchlaufen. In diesem Beispiel bringt dies keinen Vorteil, aber man kann dazu die Spalteneigenschaft des Range-Objekts nutzen:

Public Function SummeBetrag(Bereich As Excel.Range) As Double
    Dim Zelle   As Excel.Range
    Dim Spalte  As Excel.Range
    
    ' Spalten von 1 bis zur letzten Spalte durchlaufen:
    For Each Spalte In Bereich.Columns
        ' Oberste bis zur untersten Zelle durchlaufen:
        For Each Zelle In Spalte.Cells
            ' Enthält die Zelle eine Zahl?
            If IsNumeric(Zelle.Value) Then
                ' Betrag addieren:
                SummeBetrag = SummeBetrag + Abs(Zelle.Value)
            End If
        Next Zelle
    Next Spalte
End Function

Die verschachtelten For-Each Schleifen gehen dabei den markierten Bereich von oben nach unten und dann von rechts nach links durch. Wäre der Bereich A1:B2 markiert worden, würde die Summe in der Reihenfolge A1 + A2 + B1 + B2 berechnet.

Auch benutzerdefinierte Funktionen sollten fehlerhafte Bereichsauswahlen erkennen und darauf reagieren. Die drei folgenden Beispiele zeigen, wie man Bereiche überprüft:

Enthält der Bereich mehr als nur eine Zeile?

Public Function NurEineZeile(Bereich As Excel.Range) As Boolean
    ' Enthält der Bereich nur genau eine Zeile?
    ' Das Ergebnis wird als Rückgabewert der Funktion gespeichert
    NurEineZeile = (Bereich.Rows.Count = 1)

    If Not NurEineZeile Then
        ' Meldung an den Benutzer, falls mehr als eine Zeile markiert wurde
        MsgBox "Nur eine Zeile erlaubt", vbExclamation
    End If
End Function

Enthält der Bereich mehr als eine Spalte?

Public Function NurEineSpalte(Bereich As Excel.Range) As Boolean
    NurEineSpalte = (Bereich.Columns.Count = 1)
    If Not NurEineSpalte Then
        MsgBox "Nur eine Spalte erlaubt"
    End If
End Function

Ist der Bereich quadratisch?

Public Function NurQuadratischerBereich(Bereich As Excel.Range) As Boolean
    NurQuadratischerBereich = (Bereich.Rows.Count = Bereich.Columns.Count)
    If Not NurQuadratischerBereich Then
        MsgBox "Quadratischer Bereich erwartet"
    End If
End Function

Wenn eine benutzerdefinierte Funktion zwei Bereiche als Argumente erwartet, kann es erforderlich sein, dass sich diese Bereiche nicht überschneiden. Mit der Funktion Intersect wird die Schnittmenge aus beiden Bereichen bestimmt. Falls sich die Bereiche überschneiden, schreibt die Funktion den Fehler #BEZUG ins Arbeitsblatt, sonst die Anzahl der Zellen beider Bereiche:

Public Function GetrennteBereiche(Bereich1 As Excel.Range, _
                                  Bereich2 As Excel.Range) As Variant
    If Intersect(Bereich1, Bereich2) Is Nothing Then
        GetrennteBereiche = Bereich1.Cells.Count + Bereich2.Cells.Count
    Else
        GetrennteBereiche = CVErr(xlErrRef)
    End If
End Function

Damit die vorgesehene Fehlermeldung in der Zelle angezeigt werden kann, muss der Datentyp für den Rückgabewert der Funktion Variant sein, denn nur Der Datentyp Variant kann auch den speziellen Rückgabewert "Fehler" speichern.

Das folgende Beispiel erwartet je eine Spalte mit X- und zugehörigen Y-Werten. Die folgende Funktion prüft, ob die Anzahl der Zeilen gleich ist:

Public Function GleicheZeilenZahl(BereichX As Range, BereichY As Range) As Boolean
    On Error Resume Next
    GleicheZeilenZahl = (BereichX.Rows.Count = BereichY.Rows.Count)
End Function

Enthält eine der Variablen keinen Bereich, sondern den Wert Nothing, führt der fehler dazu, dass Zeile 2 nicht ausgeführt wird. Da der Default-Wert von GleicheZeilenZahl gleich False ist, ist auch im Fehlerfall der Rückgabewert korrekt.

Wenn der Anwender selbst Bereiche auswählen soll, kann der auch viel zu große Bereiche auswählen. Markiert der Anwender beispielsweise die Spalten A:C, obwohl nur der Bereich A1:C3 Daten enthält, dann bearbeitet die oben gezeigte Funktion SummeBetrag() in einer XLSX-Datei 3,2 Milliarden (3×230 Zellen, nämlich von A1:C10737741824. Um das zu verhindern, vergleicht man den ausgewählten Bereich mit dem benutzten Bereich (UsedRange) und bestimmt die Schnittmenge:

Public Sub BereichKorrigieren(Bereich As Excel.Range)
    Set Bereich = Intersect(Bereich, Bereich.Parent.UsedRange)
End Sub

Ist der Bereich durch die Objektvariable MeinBereich festgelegt, so ruft man die Funktion so auf:

BereichKorrigieren MeinBereich

Nur wenn MeinBereich mehr Zeilen und/oder mehr Spalten als der benutzte Bereich enthält, reduziert ihn die Funktion BereichKorrigieren. Ist MeinBereich dagegen kleiner gewählt, behält er seine Größe. Die Funktion verändert beim Verkleinern auch die Objektvariable MeinBereich selbst, d.h. es ist danach nicht mehr möglich, die Größe des gesamten ursprünglichen Bereichs festzustellen.

Prozeduraufrufe

Bearbeiten


Die Aufruf-Syntax

Bearbeiten

Die Syntax der Aufrufe von VBA-Programmen und -Unterprogrammen mit oder ohne Übergabe von Parametern kann sehr unterschiedlich sein. Achten Sie bitte bei Ihren VBA-Programmierungen darauf, dass Sie Unterprogramme, die sich in der gleichen Arbeitsmappe wie die aufrufende Prozedur befinden, immer mit Call aufrufen:

    Call Unterprogramm

Das vorangestellte Call ist optional, sollte aber im Interesse der Übersichtlichkeit des Codes dennoch verwendet werden.

Weichen Sie von dieser Regel nur dann ab, wenn Sie aus Ablaufgründen den Namen der aufzurufenden Unterprozedur variabel halten müssen. Weiter unten folgt hierfür ein Beispiel.

Befindet sich die aufzurufende Prozedur in einem Klassenmodul und der Aufruf erfolgt aus einem anderen Modul, so ist dem Aufruf die Klasse voranzustellen:

    Call Tabelle1.Unterprogramm

Als Private deklarierte Funktionen können nicht aufgerufen werden.

Prozeduren in anderen Arbeitsmappen oder Anwendungen werden mit Run gestartet, wobei der Makroname zusammen mit dem Namen des Container-Dokuments als String übergeben wird:

    Run "'Mappe1'!MeinMakro"

Hierbei ist zu beachten:

  • Dateinamen mit Leerzeichen müssen im Run-Aufruf in Apostrophs gesetzt werden
  • Die mit Run aufgerufene Arbeitsmappe wird - wenn nicht geöffnet - im aktuellen Verzeichnis (CurDir) gesucht. Nicht machbar ist:
  Run "'c:\mappe1.xls'!Meldung"

Die Programmierbeispiele

Bearbeiten

Aufruf eines Makros in der aktuellen Arbeitsmappe ohne Parameterübergabe

Bearbeiten

Das aufzurufende Unterprogramm befindet sich in einem Standardmodul der aufrufenden Arbeitsmappe.

  • Prozedur: CallSimple
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Unterprogramm aufrufen
  • Ablaufbeschreibung:
    • Makroaufruf
  • Code:
Sub CallSimple()
   MsgBox "Ein normaler Aufruf!"
End Sub

Aufruf einer Funktion in der aktuellen Arbeitsmappe mit Parameterübergabe

Bearbeiten
  • Prozedur: CallFunction
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Funktion mit Parameter aufrufen und Funktionsergebnis melden
  • Ablaufbeschreibung:
    • Meldung eines von einer Funktion ermittelten Wertes
  • Code:
Sub CallFunction()
   MsgBox "Anzahl der Punkte der Schaltfläche: " & vbLf & _
      CStr(GetPixel(ActiveSheet.Buttons(Application.Caller)))
End Sub

Aufruf eines Makros in einer anderen Arbeitsmappe ohne Parameterübergabe

Bearbeiten
  • Prozedur: CallWkbA
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Makro einer anderen Arbeitsmappe ohne Parameter aufrufen
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Arbeitsmappenname an String-Variable übergeben
    • Fehlerroutine starten
    • Arbeitsmappe an Objektvariable übergeben
    • Fehlerroutine beenden
    • Wenn die Arbeitsmappe nicht geöffnet ist...
    • Negativmeldung
    • Sonst...
    • Makro in anderer Arbeitsmappe starten
  • Code:
Sub CallWkbA()
   Dim sFile As String
   Dim wkb As Workbook
   sFile = "'vb07_test.xls'"
   On Error Resume Next
   Set wkb = Workbooks(sFile)
   On Error GoTo 0
   If wkb Is Nothing Then
      MsgBox "Die Testarbeitsmappe " & sFile & " wurde nicht gefunden!"
   Else
      Run sFile & "!Meldung"
   End If
End Sub

Aufruf einer Funktion in einer anderen Arbeitsmappe mit Parameterübergabe

Bearbeiten
  • Prozedur: CallWkbB
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Funktion einer anderen Arbeitsmappe mit Parameter aufrufen
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Arbeitsmappenname an String-Variable übergeben
    • Fehlerroutine starten
    • Arbeitsmappe an Objektvariable übergeben
    • Fehlerroutine beenden
    • Wenn die Arbeitsmappe nicht geöffnet ist...
    • Negativmeldung
    • Sonst...
    • Funktion in anderer Arbeitsmappe aufrufen und Ergebnis melden
  • Code:
Sub CallWkbB()
   Dim sFile As String
   Dim wkb As Workbook
   sFile = "'vb07_test.xls'"
   On Error Resume Next
   Set wkb = Workbooks(sFile)
   On Error GoTo 0
   If wkb Is Nothing Then
      MsgBox "Die Testarbeitsmappe " & sFile & " wurde nicht gefunden!"
   Else
      MsgBox Run(sFile & "!CallerName", Application.Caller)
   End If
End Sub

Aufruf eines Makros in einem Klassenmodul einer anderen Arbeitsmappe

Bearbeiten
  • Prozedur: CallWkbC
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Ein Makro im Klassenmodul einer anderen Arbeitsmappe aufrufen
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Arbeitsmappenname an String-Variable übergeben
    • Fehlerroutine starten
    • Arbeitsmappe an Objektvariable übergeben
    • Fehlerroutine beenden
    • Wenn die Arbeitsmappe nicht geöffnet ist...
    • Negativmeldung
    • Sonst...
    • Makro in anderer Arbeitsmappe starten
  • Code:
Sub CallWkbC()
   Dim sFile As String
   Dim wkb As Workbook
   sFile = "'vb07_test.xls'"
   On Error Resume Next
   Set wkb = Workbooks(sFile)
   On Error GoTo 0
   If wkb Is Nothing Then
      MsgBox "Die Testarbeitsmappe " & sFile & " wurde nicht gefunden!"
   Else
      Run sFile & "!Tabelle1.CallClassModule"
   End If
End Sub

Word-Makro aus Excel-Arbeitsmappe aufrufen

Bearbeiten
  • Prozedur: CallWord
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Ein Makro in einem Word-Dokument aufrufen
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Name des Worddokumentes an String-Variable übergeben
    • Wenn die Datei nicht existiert...
    • Negativmeldung
    • Sonst...
    • Word-Instanz bilden
    • Word-Dokument öffnen
    • Word-Makro aufrufen
    • Word-Instanz schließen
    • Objektvariable zurücksetzen
  • Code:
Sub CallWord()
   Dim wdApp As Object
   Dim sFile As String
   sFile = ThisWorkbook.Path & "\vb07_WordTest.doc"
   If Dir$(sFile) = "" Then
      MsgBox "Test-Word-Dokument " & sFile & " wurde nicht gefunden!"
   Else
      With CreateObject("Word.Application")
          .documents.Open sFile
          .Run "Project.Modul1.WdMeldung"
          .Quit
      End With
   End If
End Sub

Access-Makro aus Excel-Arbeitsmappe aufrufen

Bearbeiten
  • Prozedur: CallAccess
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Ein Makro in einer Access-Datenbank aufrufen
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Name der Access-Datenbank an String-Variable übergeben
    • Wenn die Datei nicht existiert...
    • Negativmeldung
    • Sonst...
    • Acess-Instanz bilden
    • Access-Datenbank öffnen
    • Access-Makro aufrufen
    • Access-Instanz schließen
    • Objektvariable zurücksetzen
  • Code:
Sub CallAccess()
   Dim accApp As Object
   Dim sFile As String
   ' Pfad, wenn die Access-MDB im gleichen Verzeichnis wie die XLS-Datei liegt 
   sFile = ThisWorkbook.Path & "\vb07_AccessTest.mdb"
   If Dir(sFile) = "" Then
      Beep
      MsgBox "Access-Datenbank wurde nicht gefunden!"
   Else
      With CreateObject("Access.Application")
          .OpenCurrentDatabase sFile
          .Run "AcMeldung"
          .CloseCurrentDatabase
      End With
   End If
End Sub

Aufruf von Prozeduren in der aktuellen Arbeitsmappe mit variablen Makronamen

Bearbeiten
  • Prozedur: CallMacros
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Makros mit variablen Makronamen aufrufen
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Die letzten 6 Zeichen des Namens der aufrufenden Schaltfläche an eine String-Variable übergeben
    • Meldung, dass jetzt zu dem Makro mit dem in der String-Variablen hinterlegten Namen verzweigt wird
    • Makro mit dem in der String-Variablen hinterlegten Namen aufrufen
  • Code:
Sub CallMacros()
   Dim sMacro As String
   sMacro = Right(Application.Caller, 6)
   MsgBox "Ich verzweige jetzt zu " & sMacro
   Run sMacro
End Sub

Gültigkeit von Variablen und Konstanten

Bearbeiten


Deklaration von Variablen

Bearbeiten

Variablen sind Platzhalter für Zeichenfolgen, Werte und Objekte. Um neue Variablen erstmalig zu verwenden, müssen sie deklariert werden, indem ihnen ein Variablentyp zugewiesen wird. Dies geschieht in den meisten Fällen durch die dim-Anweisung

Dim intCounter as Integer

Die Gültigkeit

Bearbeiten

Die Gültigkeit und die Lebensdauer der Werte der Variablen werden durch den Ort und die Art ihrer Deklaration festgelegt.

  • Deklaration innerhalb einer Prozedur
    Die Variable hat ihre Gültigkeit ausschließlich für diese Prozedur und kann aus anderen Prozeduren nicht angesprochen werden.
  • Deklaration im Modulkopf
    Die Variable gilt für alle Prozeduren dieses Moduls, eine Weitergabe als Parameter ist nicht notwendig.
  • Deklaration im Modulkopf eines Standardmoduls als Public
    Die Variable gilt für alle Prozeduren der Arbeitsmappe, soweit das die Prozedur enthaltende Modul nicht als Private deklariert ist.

Empfehlenswert ist die grundsätzliche Vermeidung von Public-Variablen und der Verzicht auf Variablen auf Modulebene. Es ist nicht immer einfach zu beurteilen, wann diese öffentlichen Variablen ihren Wert verlieren oder wo er geändert wird. Die sauberste Lösung ist die Deklaration innerhalb der Prozeduren und die Weitergabe als Parameter.

Wenn Sie mit öffentlichen Variablen arbeiten, sollten Sie Ihre Variablennamen gemäß den Programmier-Konventionen vergeben und sie so als öffentlich kennzeichnen. Ein vorangestelltes g (für “global“) könnte darauf hinweisen, dass es sich um eine Public-Variable, ein kleines m, dass es sich um eine Variable auf Modulebene handelt.

In den nachfolgenden Beispielen wird Deklaration und Verhalten von Variablen demonstriert.

Die Beispiele

Bearbeiten

Deklaration auf Prozedurebene

Bearbeiten

Eine Variable ist innerhalb einer Prozedur deklariert und nur in dieser Prozedur gültig.

  • Prozedur: varA
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Wert an Integer-Variable übergeben
    • Wert melden
  • Code:
Sub VarA()
   Dim iValue As Integer
   iValue = 10 + 5
   MsgBox "Variablenwert: " & iValue
End Sub

Deklaration auf Modulebene

Bearbeiten

Eine Variable ist innerhalb eines Moduls in jeder Prozedur gültig und wird im Modulkopf deklariert.

  • Prozedur: varB und ProcedureA
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Variablendeklaration im Modulkopf
    • Wert an Double-Variable übergeben
    • Unterprogramm ohne Parameter aufrufen
    • Variablenwert melden
  • Code:
Dim mdModul As Double

Sub VarB()
   mdModul = 23 / 14
   Call ProcedureA
End Sub

Private Sub ProcedureA()
   MsgBox "Variablenwert: " & mdModul
End Sub

Statische Variable

Bearbeiten

Eine Variable ist innerhalb einer Prozedur als statisch deklariert und behält bei neuen Prozeduraufrufen ihren Wert.

  • Prozedur: varC
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Aufrufzähler hochzählen
    • Wert melden
    • Wert hochzählen
  • Code:
Sub VarC()
   Static iValue As Integer
   Static iCount As Integer
   iCount = iCount + 1
   MsgBox iCount & ". Aufruf: " & iValue
   iValue = iValue + 100
End Sub

Public-Variable

Bearbeiten

Eine Variable ist in der Arbeitsmappe in jedem Modul gültig und im Modulkopf eines Moduls als Public deklariert.

  • Prozedur: varD und varE für den Folgeaufruf
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Variablendeklaration im Modulkopf
    • Arbeitsblatt an Objektvariable übergeben
    • Arbeitsblattnamen melden
  • Im zweiten Aufruf:
    • Wenn die Objekt-Variable nicht initialisiert ist...
    • Warnton
    • Negativmeldung
    • Sonst...
    • Arbeitsblattnamen melden
  • Code:
Public gwksMain As Worksheet

Sub VarD()
   Set gwksMain = Worksheets("Tabelle1")
   MsgBox "Blattname: " & gwksMain.Name
End Sub

Sub varE()
   If gwksMain Is Nothing Then
      Beep
      MsgBox "Bitte zuerst über Beispiel D initialisieren!"
   Else
      MsgBox "Blattname: " & gwksMain.Name
   End If
End Sub

Übergabe von Variablen an eine Funktion

Bearbeiten

Variablen an eine Funktion übergeben und den Rückgabewert melden.

  • Prozedur: varF und Funktion GetCbm
  • Art: Sub/Funktion
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Funktions-Rückgabewert in eine Double-Variable einlesen
    • Ergebnis melden
  • Die Funktion:
    • Rückgabewert berechnen
  • Code:
Sub varF()
   Dim dCbm As Double
   dCbm = GetCbm(3.12, 2.44, 1.58)
   MsgBox "Kubikmeter: " & Format(dCbm, "0.00")
End Sub

Private Function GetCbm( _
   dLength As Double, _
   dWidth As Double, _
   dHeight As Double)
   GetCbm = dLength * dWidth * dHeight
End Function

ByRef-Verarbeitung in einem Unterprogramm

Bearbeiten

Variable ByRef an ein Unterprogramm übergeben und den veränderten Rückgabewert melden.

  • Prozedur: varG und Unterprogramm ProcedureB
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Variable für Rückgabewert initialisieren
    • Unterprogramm mit Parametern aufrufen
    • Ergebnis melden
  • Das Unterprogramm:
    • Rückgabewert berechnen
  • Code:
Sub varG()
   Dim dCbm As Double
   dCbm = 0
   Call ProcedureB(3.12, 2.44, 1.58, dCbm)
   MsgBox "Kubikmeter: " & dCbm
End Sub

Private Sub ProcedureB( _
   ByVal dLength As Double, _
   ByVal dWidth As Double, _
   ByVal dHeight As Double, _
   ByRef dErgebnis As Double)
   dErgebnis = dLength * dWidth * dHeight
End Sub

Übergabe von Variablen an eine andere Arbeitsmappe

Bearbeiten

Variable an eine Funktion einer anderen Arbeitsmappe übergeben und den Rückgabewert melden.

  • Prozedur: varH und Funktion in anderer Arbeitsmappe
  • Art: Sub/Funktion
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Pfad und Dateinamen der Test-Arbeitsmappe an String-Variable übergeben
    • Wenn die Test-Arbeitsmappe nicht gefunden wurde...
    • Negativmeldung
    • Sonst...
    • Bildschirmaktualisierung ausschalten
    • Wert an Long-Variable übergeben
    • Test-Arbeitsmappe öffnen
    • Funktion in der Text-Arbeitsmappe aufrufen und Ergebnis in Long-Variable einlesen
    • Test-Arbeitsmappe schließen
    • Bildschirmaktualisierung einschalten
    • Rückgabewert melden
  • Code:
Sub varH()
   Dim lValue As Long
   Dim sFile As String
   sFile = ThisWorkbook.Path & "\vb04_test.xls"
   If Dir(sFile) = "" Then
      MsgBox "Die Testdatei " & sFile & " fehlt!"
   Else
      Application.ScreenUpdating = False
      lValue = 12345
      Workbooks.Open sFile
      lValue = Application.Run("vb04_test.xls!Berechnung", lValue)
      ActiveWorkbook.Close savechanges:=False
      Application.ScreenUpdating = True
      MsgBox "Ergebnis: " & lValue
   End If
End Sub

Function Berechnung(lWert As Long)
   Berechnung = lWert * 54321
End Function

Variablen füllen und zurücksetzen

Bearbeiten

Variablenwerte werden belegt und zurückgesetzt.

  • Prozedur: varI
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Variablendeklaration
    • Aktives Arbeitsblatt an eine Objekt-Variable übergeben
    • Schleife bilden
    • Array mit Werten füllen
    • Meldung mit Arbeitsblattnamen, Array-Inhalt und Wert der Zählvariablen
    • Meldung, dass die Werte zurückgesetzt werden
    • Objektvariable zurücksetzen
    • Array zurücksetzen
    • Zählvariable zurücksetzen
    • Fehlerroutine initialisieren
    • Arbeitsblattnamen melden (führt zum Fehler)
    • Wert des ersten Datenfeldes melden (leer)
    • Wert der Zählvariablen melden (0)
    • Prozedur verlassen
    • Fehlerroutine
    • Wenn es sich um die Fehlernummer 91 handelt...
    • Meldung mit Fehlernummer und Fehlertext
    • Nächste Programmzeile abarbeiten
  • Code:
Sub varI()
   Dim wks As Worksheet
   Dim arr(1 To 3) As String
   Dim iCounter As Integer
   Set wks = ActiveSheet
   For iCounter = 1 To 3
      arr(iCounter) = Format(DateSerial(1, iCounter, 1), "mmmm")
   Next iCounter
   MsgBox "Name des Objeks Arbeitsblatt:" & vbLf & _
      "   " & wks.Name & vbLf & vbLf & _
      "Inhalt des Arrays:" & vbLf & _
      "   " & arr(1) & vbLf & _
      "   " & arr(2) & vbLf & _
      "   " & arr(3) & vbLf & vbLf & _
      "Inhalt der Zählvariablen:" & vbLf & _
      "   " & iCounter
   MsgBox "Jetzt werden die Variablen zurückgesetzt!"
   Set wks = Nothing
   Erase arr
   iCounter = 0
   On Error GoTo ERRORHANDLER
   MsgBox wks.Name
   MsgBox "Wert des ersten Datenfeldes: " & arr(1)
   MsgBox "Wert der Zählvariablen: " & iCounter
   Exit Sub
ERRORHANDLER:
   If Err = 91 Then
      MsgBox "Fehler Nr. " & Err & ": " & Error
      Resume Next
   End If
End Sub

Konstanten auf Prozedurebene

Bearbeiten

Konstante auf Prozedurebene als Endpunkt einer Schleife.

  • Prozedur: varJ
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Konstantendeklaration
    • Variablendeklaration
    • Schleife bilden
    • Schleife beenden
    • Zählvariable melden
  • Code:
Sub varJ()
   Const ciLast As Integer = 100
   Dim iCounter As Integer
   For iCounter = 1 To ciLast
   Next iCounter
   MsgBox "Zähler: " & iCounter
End Sub

Public-Konstanten

Bearbeiten

Public-Konstante für alle Prozeduren der Arbeitsmappe.

  • Prozedur: varK
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Konstantendeklaration im Modulkopf
    • Meldung mit der Public-Konstanten
  • Code:
Public Const gciDecember  As Integer = 12

Sub varK()
   MsgBox "Monat Dezember hat den Index " & gciDecember
End Sub

Übergabe eines variablen Wertes an eine Konstante

Bearbeiten

Variabler Wert als Konstante. Gegen Versuche, einen variablen Wert an eine Konstante zu übergeben, wehrt sich VBA vehement. Das Beispiel zeigt eine Möglichkeit, das Problem zu umgehen.

  • Prozedur: varL
  • Art: Sub
  • Modul: Standardmodul
  • Zweck: Variablendemonstration
  • Ablaufbeschreibung:
    • Konstantendeklaration
    • Meldung mit der variablen Konstanten
  • Code:
Sub varL()
   Const cDay As String = "Day(Now())"
   MsgBox "Tageskonstante: " & Evaluate(cDay)
End Sub

ByRef und ByVal

Bearbeiten


Zu ByRef und ByVal

Bearbeiten

Variablen können an Funktionen oder Unterprogramme übergeben, dort zu Berechnungen verwendet und mit geänderten Werten zurückgegeben werden. Entscheidend hierfür ist das Schlüsselwort der Parameter-Definition des aufnehmenden Unterprogramms.

VBA kennt die Parameterübergaben ByRef (Übergabe der Referenz auf die Speicherstelle mit dem Wert der Variablen) und ByVal (Übergabe des Wertes der Variablen). Im ersten Fall – das ist die Standardeinstellung, d.h. wenn keine Vorgabe erfolgt, wird der Parameter als ByRef behandelt – wird der Wert des Parameters weiterverarbeitet; Änderungen sind auch für das aufrufende Programm wirksam. Im zweiten Fall wird eine Kopie des Parameters übergeben; die Wirksamkeit beschränkt sich auf das aufgerufene Unterprogramm und der Parameter im aufrufenden Programm behält seinen ursprünglichen Wert.

Die Beispiele

Bearbeiten

Aufruf einer benutzerdefinierten Funktion ohne ByRef/ByVal-Festlegung

Bearbeiten

Die Funktion errechnet anhand der übergebenen Parameter den Wert und gibt diesen an das aufrufende Programm zurück, wobei die übergebenen Parameter nicht geändert werden.

Sub CallFunction()
   Dim dQM As Double
   dQM = fncQM( _
      Range("A2").Value, _
      Range("B2").Value, _
      Range("C2").Value)
   MsgBox "Quadratmeter Außenfläche: " & _
      Format(dQM, "0.000")
End Sub

Private Function fncQM( _
   dLong As Double, dWidth As Double, dHeight As Double)
   fncQM = 2 * (dLong * dWidth + _
      dLong * dHeight + _
      dWidth * dHeight)
End Function

Aufruf eines Unterprogramms ohne ByRef/ByVal-Festlegung

Bearbeiten

Das Unterprogramm wird mit den für die Berechnung notwendigen Parametern und zusätzlich mit einer 0-Wert-Double-Variablen, die als Container für das Berechnungsergebnis dient, aufgerufen. Alle Parameter gelten als ByRef, da kein Schlüsselwort verwendet wurde.

Sub CallMacro()
   Dim dQM As Double
   Call GetQm( _
      dQM, _
      Range("A2").Value, _
      Range("B2").Value, _
      Range("C2").Value)
   MsgBox "Quadratmeter Außenfläche: " & _
      Format(dQM, "0.000")
End Sub

Private Sub GetQm( _
   dValue As Double, dLong As Double, _
   dWidth As Double, dHeight As Double)
   dValue = 2 * (dLong * dWidth + _
      dLong * dHeight + _
      dWidth * dHeight)
End Sub

Aufruf mit einer Integer-Variablen bei Anwendung von ByVal

Bearbeiten

Das Unterprogramm wird mit einer Variablen aufgerufen. Der Wert dieser Variablen verändert sich während des Ablaufs des Unterprogramms, ohne dass sich im aufrufenden Programm der Variablenwert ändert.

Sub AufrufA()
   Dim iRow As Integer, iStart As Integer
   iRow = 2
   iStart = iRow
   Call GetRowA(iRow)
   MsgBox "Ausgangszeile: " & iStart & _
      vbLf & "Endzeile: " & iRow
End Sub

Private Sub GetRowA(ByVal iZeile As Integer)
   Do Until IsEmpty(Cells(iZeile, 1))
      iZeile = iZeile + 1
   Loop
End Sub

Aufruf mit einer Integer-Variablen bei Anwendung von ByRef

Bearbeiten

Das Unterprogramm wird mit einer Variablen aufgerufen. Der Wert dieser Variablen verändert sich während des Ablaufs des Unterprogramms, damit auch der Wert der Variablen im aufrufenden Programm.

Sub AufrufB()
   Dim iRow As Integer, iStart As Integer
   iRow = 2
   iStart = iRow
   Call GetRowB(iRow)
   MsgBox "Ausgangszeile: " & iStart & _
      vbLf & "Endzeile: " & iRow
End Sub

Private Sub GetRowB(ByRef iZeile As Integer)
   Do Until IsEmpty(Cells(iZeile, 1))
      iZeile = iZeile + 1
   Loop
End Sub

Aufruf mit einer String-Variablen bei Anwendung von ByVal

Bearbeiten

Das Unterprogramm wird mit einer Variablen aufgerufen. Der Wert dieser Variablen verändert sich während des Ablaufs des Unterprogramms, ohne dass sich im aufrufenden Programm der Variablenwert ändert.

Sub CallByVal()
   Dim sPath As String, sStart As String
   sPath = ThisWorkbook.Path
   sStart = sPath
   Call GetByVal(sPath)
   MsgBox "Vorher: " & sStart & _
      vbLf & "Nachher: " & sPath
End Sub

Private Sub GetByVal(ByVal sDir As String)
   If Right(sDir, 1) <> "\" Then
      sDir = sDir & "\"
   End If
End Sub

Aufruf mit einer String-Variablen bei Anwendung von ByRef

Bearbeiten

Das Unterprogramm wird mit einer Variablen aufgerufen. Der Wert dieser Variablen verändert sich während des Ablauf des Unterprogramms, damit auch der Wert der Variablen im aufrufenden Programm.

Sub CallByRef()
   Dim sPath As String, sStart As String
   sPath = ThisWorkbook.Path
   sStart = sPath
   Call GetByRef(sPath)
   MsgBox "Vorher: " & sStart & _
      vbLf & "Nachher: " & sPath
End Sub

Private Sub GetByRef(ByRef sDir As String)
   If Right(sDir, 1) <> "\" Then
      sDir = sDir & "\"
   End If
End Sub

Aufruf mit einer Objekt-Variablen bei Anwendung von ByVal

Bearbeiten

Das Unterprogramm wird mit einer Variablen aufgerufen. Der Wert dieser Variablen verändert sich während des Ablaufs des Unterprogramms, ohne dass sich im aufrufenden Programm der Variablenwert ändert.

Sub CallObjectA()
   Dim rngA As Range, rngB As Range
   Set rngA = Range("A1:A10")
   Set rngB = rngA
   Call GetObjectA(rngA)
   MsgBox "Vorher: " & rngB.Address(False, False) & _
      vbLf & "Nachher: " & rngA.Address(False, False)
End Sub

Private Sub GetObjectA(ByVal rng As Range)
   Set rng = Range("F1:F10")
End Sub

Aufruf mit einer Objekt-Variablen bei Anwendung von ByRef

Bearbeiten

Das Unterprogramm wird mit einer Objekt-Variablen aufgerufen. Der Wert dieser Variablen, also der Verweis auf ein Objekt, verändert sich während des Ablaufs des Unterprogramms, damit auch der Wert der Objekt-Variablen im aufrufenden Programm. Das Objekt, auf das die Variable ursprünglich verwies, bleibt aber unverändert.

Sub CallObjectB()
   Dim rngA As Range, rngB As Range
   Set rngA = Range("A1:A10")
   Set rngB = rngA
   Call GetObjectB(rngA)
   MsgBox "Vorher: " & rngB.Address(False, False) & _
      vbLf & "Nachher: " & rngA.Address(False, False)
End Sub

Private Sub GetObjectB(ByRef rng As Range)
   Set rng = Range("F1:F10")
End Sub

Selektieren und Aktivieren

Bearbeiten


Selection, muss das sein?

Bearbeiten

Die nachfolgende Abhandlung mag manchem in der Entschiedenheit übertrieben erscheinen, dennoch hält der Autor eine klare Position in diesem Thema für angebracht, da das Selektieren und Aktivieren von Trainern und Dozenten auch nach einigen Jahren VBA weiter unterstützt wird und sie in der Regel selbst zu eifrigen Selektierern gehören. Ein kleiner Teil hebt sich wohltuend von der Mehrheit ab. Auch in der Literatur wird aus der Angst heraus, sich Laien gegenüber nicht verständlich machen zu können, das Thema falsch behandelt.

Worum geht es hier?

Bearbeiten

Es gibt in MS Office wie auch im wirklichen Office mehrere Möglichkeiten, ein Objekt (MS Office) oder einen Mitarbeiter (Office) anzusprechen oder ihm Anweisungen zu erteilen. Um einem Mitarbeiter in einer Abteilung eines anderen Werkes die freudige Mitteilung einer Gehaltserhöhung - über die sich sein danebenstehender Kollege gelb ärgert - zu übermitteln, kann man ihm das entweder über die Hauspost mitteilen lassen oder ihn in dem anderen Werk besuchen.

In VBA wäre die erste Vorgehensweise Referenzieren und die zweite Selektieren. Als Code sieht die erste Variante so aus:

Sub Referenzieren()
   With Workbooks("Factory.xls").Worksheets("Abteilung").Range("A1")
      .Value = "Gehaltserhöhung"
      .Interior.ColorIndex = 3
      .Font.Bold = True
      With .Offset(1, 0)
         .Interior.ColorIndex = 6
         .Font.Bold = False
      End With
   End With
End Sub

Der Selektierer hat, um zum gleichen Ergebnis zu kommen, schon etwas mehr Arbeit:

Sub Hingehen()
   Dim wkb As Workbook
   Application.ScreenUpdating = False
   Set wkb = ActiveWorkbook
   Workbooks("Factory.xls").Activate
   Worksheets("Abteilung").Select
   Range("A1").Select
   With Selection
      .Value = "Gehaltserhöhung"
      .Interior.ColorIndex = 3
      .Font.Bold = True
   End With
   Range("A2").Select
   With Selection
      .Interior.ColorIndex = 6
      .Font.Bold = False
   End With
   wkb.Activate
   Application.ScreenUpdating = True
End Sub

Im Bürobeispiel bekommt er für seine Mehrleistung den Zusatznutzen, die Freude des Gehaltserhöhten und den Neid dessen Kollegen live mitzuerleben, bei VBA bleibt es bei der Mehrarbeit.

Wieso ist das Selektieren so verbreitet?

Bearbeiten

Dass man kaum Code ohne Selektiererei sieht - hiervon sind viele Code-Beispiele aus dem Hause Microsoft nicht ausgeschlossen - ist vor allem in folgenden Dingen begründet:

  • Fast jeder in MS Excel mit VBA Programmierende hat seine ersten VBA-Schritte mit dem Makrorecorder gemacht. Der Recorder ist der Meister des Selektierens und des überflüssigen Codes. Es sei ihm gestattet; er hat keine andere Chance.
  • Es erleichtert die Flucht vor abstraktem Denken, indem in die Objekte eine Begrifflichkeit gelegt wird, die nur fiktiv ist.
  • Es wird von denen, die VBA vermitteln sollen, eingesetzt, um den Lernenden einen Bezug zu den Objekten zu vermitteln. Dies erleichtert zugegebenermaßen die ersten Schritte in diese Programmiersprache, wirkt sich jedoch später eher als Fluch aus.
  • In wesentlich stärkerem Maße als bei anderen Programmiersprachen kommen die Programmierenden aus dem Anwenderbereich und/oder dem der autodidaktisch Lernenden und besitzen in der Regel keine umfassende Ausbildung in den Grundlagen der Programmierung.

Selektieren und Referenzieren aufgrund unterschiedlichen Denkens?

Bearbeiten

Der typischer Gedankengang eines Selektierers:

Wenn ich jetzt in das Arbeitsblatt Tabelle1 der Arbeitsmappe Test1 und dort in Zelle F10 gehe, den dortigen Zellinhalt kopiere, ihn dann in Arbeitsblatt Tabelle2 von Arbeitsmappe Test2 trage und in Zelle B5 ablade, habe ich das Ergebnis, was ich haben möchte. Jetzt kann ich wieder in die Arbeitsmappe zurückgehen, von der aus ich losgegangen bin.

Diese Überlegung schlägt sich bei ihm in folgendem Code nieder:

Sub SelektiertKopieren()
   Dim wkb As Workbook
   Set wkb = ActiveWorkbook
   Workbooks("Test1.xls").Activate
   Worksheets("Tabelle1").Select
   Range("F10").Select
   Selection.Copy
   Workbooks("Test2.xls").Activate
   Worksheets("Tabelle2").Select
   ActiveSheet.Range("B5").Select
   ActiveSheet.Paste Destination:=ActiveCell
   wkb.Activate
   Application.CutCopyMode = False
End Sub

Wäre er kein Selektierer, würde er sich sagen, ich kopiere aus Arbeitsmappe Test1, Tabelle1, Zelle F10 nach Arbeitsmappe Test2, Tabelle2, Zelle B5.

So sähe dann sein Code auch aus:

Sub ReferenziertKopieren()
   Workbooks("Test1").Worksheets("Tabelle1").Range("F10").Copy _
      Workbooks("Test2").Worksheets("Tabelle2").Range("B5")
   Application.CutCopyMode = False
End Sub

Warum soll nicht selektiert werden?

Bearbeiten

Neben der bekannten Tatsache, dass es sich beim Cursor um keinen Auslauf benötigenden Dackel handelt, eher um einen ausgesprochen faulen Hund, der nichts mehr als seine Ruhe liebt, spricht noch folgendes gegen das Selektieren:

  • Selektieren macht den Code unübersichtlich. Da an jeder Ecke von Selection gesprochen wird, verliert man leicht den Überblick, was denn nun gerade selektiert ist. Besonders gravierend fällt dies bei der VBA-Bearbeitung von Diagrammen auf.
  • Werden Programme von Dritten weiterbearbeitet, sollte man den nachfolgend damit Beschäftigten die Herumirrerei im Selection-Dschungel ersparen.
  • Es wird erheblich mehr Code benötigt. Jede zusätzliche Codezeile ist eine zusätzliche potentielle Fehlerquelle und wirkt sich negativ auf die Performance aus. Die Dateigröße verändert sich nicht entscheidend.
  • Der Programmablauf wird unruhig und flackernd. Dies kann nicht in jedem Fall durch Setzen des ScreenUpdating-Modus auf False verhindert werden.

In welchen Fällen sollte selektiert werden?

Bearbeiten

Es gibt einige Situationen, in denen Selektieren entweder notwendig oder sinnvoll ist. Verlangt wird es von Excel nur in einer verschwindend geringen Anzahl von Fällen. Um einen zu nennen: Das Fenster ist nur zu fixieren, wenn die Tabelle, für die die Fixierung gelten soll, aktiviert ist. Sinnvoll kann es sein, wenn umfangreicher Code mit Arbeiten an und mit Objekten in zwei Arbeitsblättern befasst ist - beispielsweise einem Quell- und einem Zielblatt, zum Programmstart aber ein drittes das Aktive ist. Um den Code übersichtlich und die Schreibarbeit in Grenzen zu halten, kann man jetzt eines der beiden Blätter aktivieren und das andere in einen With-Rahmen einbinden. Man erspart sich dadurch die beidseitige Referenzierung.

Wie kann ich das Selektieren verhindern?

Bearbeiten

Die Selektiererei lässt sich verhindern durch eine exakte Variablendeklaration und -dimensionierung sowie einer darauf aufbauenden genauen Referenzierung der Objekte.

Im Nachfolgenden einige Beispiele:

Kopieren eines Zellbereiches von einer zur anderen Arbeitsmappe, aufgerufen aus einer dritten

Sub Kopieren()
   Dim rngSource As Range, rngTarget As Range
   Set rngSource = Workbooks("Test1.xls").Worksheets(1).Range("A1:F14")
   Set rngTarget = Workbooks("Test2.xls").Worksheets(2).Range("C16")
   rngSource.Copy rngTarget
End Sub

Einfügen einer Grafik in eine zweite Arbeitsmappe

Sub BildEinfuegenPositionieren()
   Dim wks As Worksheet
   Dim pct As Picture
   Set wks = Workbooks("Test1.xls").Worksheets(1)
   Set pct = wks.Pictures.Insert("c:\excel\zelle.gif")
   pct.Left = 120
   pct.Top = 150
End Sub

In Arbeitsblättern 3 bis 12 je einer Serie von 8 Diagrammen in jedem 2. Diagramm den ersten drei SeriesCollections Trendlinien hinzufügen

Sub Aufruf()
   Dim wks As Worksheet
   Dim intCounter As Integer
   For intCounter = 3 To 12
      Call Trendlinie(wks)
   Next intCounter
End Sub

Private Sub Trendlinie(wksTarget As Worksheet)
   Dim trdLine As Trendline
   Dim intChart As Integer, intCll As Integer
   For intChart = 1 To 7 Step 2
      With wksTarget.ChartObjects(intChart).Chart
         For intCll = 1 To 3
            Set trdLine = .SeriesCollection(intCll).Trendlines.Add(Type:=xlLinear)
            With trdLine.Border
               Select Case intCll
                  Case 1
                     .ColorIndex = 5
                     .LineStyle = xlDot
                     .Weight = xlThin
                  Case 2
                     .ColorIndex = 7
                     .LineStyle = xlDot
                     .Weight = xlThin
                  Case 3
                     .ColorIndex = 6
                     .LineStyle = xlDot
                     .Weight = xlThin
               End Select
            End With
         Next intCll
      End With
   Next intChart
End Sub

Bereich im aktiven Blatt filtern und die gefilterten Daten in eine neue Arbeitsmappe kopieren. Am Ende wird die aktive Zelle selektiert, um die Filterauswahl aufzuheben.

Sub FilternKopieren()
   Dim wkb As Workbook
   Set wkb = ActiveWorkbook
   Application.ScreenUpdating = False
   Range("A1").AutoFilter field:=3, Criteria1:="*2*"
   Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
   Workbooks.Add
   ActiveSheet.Paste Destination:=Range("A1")
   Columns.AutoFit
   wkb.Activate
   ActiveSheet.AutoFilterMode = False
   Application.CutCopyMode = False
   ActiveCell.Select
End Sub

Schleifen

Bearbeiten


Siehe auch: VBA in Excel/_Beispiele für Schleifen

For-Schleifen

Bearbeiten

Einfache For-Schleifen

Bearbeiten

Einfache For-Schleife zum Eintragen von Zahlen in eine Tabelle

Bearbeiten

In die erste Spalte des aktiven Arbeitsblattes werden die Ziffern 1 bis 100 eingetragen:

Sub EintragenZahlen()
   Dim intRow As Integer
   For intRow = 1 To 100
      Cells(intRow, 1) = intRow
   Next intRow
End Sub

Einfache For-Schleife zum Eintragen von Wochentagen in eine Tabelle

Bearbeiten

Als einzige Veränderung zum obigen wird in diesem Beispiel über die Zählvariable der Wochentag, beginnend beim Sonntag, eingetragen.

Sub EintragenWochenTage()
   Dim intTag as Integer
   For intTag = 2 To 8
      Cells(intTag, 1) = Format(intTag, "dddd")
   Next intTag
End Sub

Einfache For-Schleife mit variablem Ende

Bearbeiten

For-Schleife zum Eintragen einer zu ermittelnden Anzahl von Tagen

Bearbeiten

Start oder Ende einer Schleife liegen nicht immer fest und müssen möglicherweise bestimmt werden. Hier wird über die DateSerial-Funktion aus VBA der letzte Tag des aktuellen Monats bestimmt, um, beginnend bei Zelle E1, die Datumseintragungen des aktuellen Monats vorzunehmen.

Sub EintragenMonatTage()
   Dim intTag As Integer
   For intTag = 1 To Day(DateSerial(Year(Date), Month(Date) + 1, 0))
      Cells(intTag, 5) = DateSerial(Year(Date), Month(Date), intTag)
   Next intTag
End Sub

Verschachtelte For-Schleife

Bearbeiten

Verschachtelte For-Schleife zum Eintragen des aktuellen Kalenderjahres

Bearbeiten

Die Variablen für Jahr, Monat und Tag werden dimensioniert. Das aktuelle Jahr wird an die Jahresvariable übergeben. Die äussere Schleife führt über die 12 Monate, wobei in Zeile 1 der jeweilige Monatsname eingetragen wird. Die innere Schleife führt über die Anzahl der Tage des jeweiligen Monats und trägt das jeweilige Datum in die Zellen ein. Zu beachten ist, dass Zeilen- und Schleifenzähler unterschiedliche Werte haben können. Im Beispiel werden die Tage erst ab Zeile 2 eingetragen, also wird der Zeilen- gegenüber dem Schleifenzähler um 1 hochgesetzt.

Sub EintragenJahr()
   Dim intYear As Integer, intMonat As Integer, intTag As Integer
   intYear = Year(Date)
   For intMonat = 1 To 12
      Cells(1, intMonat) = Format(DateSerial(1, intMonat, 1), "mmmm")
      For intTag = 1 To Day(DateSerial(intYear, intMonat + 1, 0))
         Cells(intTag + 1, intMonat) = Format(DateSerial(Year(Date), intMonat, intTag))
      Next intTag
   Next intMonat
End Sub

Do-Schleifen

Bearbeiten

Do-Schleifen

Bearbeiten

Do-Schleifen, ähnlich wie While-Schleifen, wiederholen sich beliebig oft. Die Schleife wird erst durch die Anweisung "Exit Do" beendet, die innerhalb der Do-Schleife z.B.(?) in einer If-Abfrage umgesetzt wird.

In dieser Do-Schleife wird eine Zufallszahl ermittelt. Wenn diese dem Index des aktuellen Monats entspricht, erfolgt eine Ausgabe in einer MsgBox.

Sub Zufall()
   Dim intCounter As Integer, intMonth As Integer
   Randomize
   Do
      intCounter = intCounter + 1
      intMonth = Int((12 * Rnd) + 1)
      If intMonth = Month(Date) Then
         MsgBox "Der aktuelle Monat " & _
         Format(DateSerial(1, intMonth, 1), "mmmm") & _
            " wurde im " & intCounter & _
            ". Versuch gefunden!"
         Exit Do
      End If
   Loop
End Sub

Do-While-Schleifen

Bearbeiten

In dieser Do-While-Schleife, startend in Zelle A1, werden die Zellen abwärts geprüft, ob ein Suchbegriff darin vorkommt. Ist die Fundstelle erreicht, wird die Schleife verlassen und eine Meldung ausgegeben

Sub SuchenBegriff()
   Dim intRow As Integer
   intRow = 1
   Do While Left(Cells(intRow, 1), 7) <> "Zeile 7"
      intRow = intRow + 1
   Loop
   MsgBox "Suchbegriff wurde in Zelle " & _
      Cells(intRow, 1).Address & " gefunden!"
End Sub

Do-Until-Schleifen

Bearbeiten

In dieser Do-Until-Schleife wird eine Zählvariable hochgezählt, bis der aktuelle Monat erreicht wird. Die Ausgabe erfolgt in einer Messagebox.

Sub PruefenWerte()
   Dim intCounter As Integer
   intCounter = 1
   Do Until Month(DateSerial(Year(Date), intCounter, 1)) = _
      Month(Date)
      intCounter = intCounter + 1
   Loop
   MsgBox "Der aktuelle Monat ist:" & vbLf & _
      Format(DateSerial(Year(Date), intCounter, 1), "mmmm")
End Sub

For-Each-Schleifen

Bearbeiten

Es wird eine Objektvariable für ein Arbeitsblatt angelegt und alle Arbeitsblätter einer Arbeitsmappe werden durchgezählt. Das Ergebnis wird in einer MsgBox ausgegeben.

Sub ZaehlenBlaetter()
    Dim wks As Worksheet
    Dim intCounter As Integer
    For Each wks In Worksheets
        intCounter = intCounter + 1
    Next wks
    If intCounter = 1 Then
        MsgBox "Die aktive Arbeitsmappe hat 1 Arbeitsblatt!"
    Else
        MsgBox "Die aktive Arbeitsmappe hat " & _
            intCounter & " Arbeitsblätter!"
    End If
End Sub

While-Schleifen

Bearbeiten

Beispiel ohne "echte" Funktion, dient lediglich zur Veranschaulichung der While-Schleife. Die Schleife zählt so lange hoch (nach jedem Schritt wird das neue Ergebnis ausgegeben) bis die While-Bed. nicht mehr erfüllt ist. Im Gegensatz zur Do-While-Schleife muss die While-Schleife mit "Wend" (steht für "While-Schleifen Ende") beendet werden! (Siehe auch Unterschied While-Wend / Do-While-Loop)


Sub WhileBsp()
    Dim i As Integer
    i = 0
    While i <> 3
        MsgBox "While-Schleife: " & i
        i = i + 1
    Wend
End Sub

Wenn-Abfragen

Bearbeiten


Einfache Verzweigung (If … Then)

Bearbeiten

Wenn es sich beim aktuellen Tag um einen Sonntag handelt, wird eine entsprechende Meldung ausgegeben, wenn nicht, erfolgt keine Aktion.

Sub WennSonntagMsg()
   If Weekday(Date) = 1 Then MsgBox "Heute ist Sonntag"
End Sub

Wenn/Dann/Sonst-Verzweigung (If … Then … Else)

Bearbeiten

In der Regel werden Wenn-/Dann-Abfragen erstellt, um Verzweigungen zu ermöglichen. In Beispiel 2.2 wird bei WAHR die Sonntagsmeldung, bei FALSCH der aktuelle Wochentag ausgegeben.

Sub WennSonntagOderMsg()
   If Weekday(Date) = 1 Then
      MsgBox "Heute ist Sonntag"
   Else
      MsgBox "Heute ist " & Format(Weekday(Date), "dddd")
   End If
End Sub

Wenn-Dann-SonstWenn-Verzweigung (If..Then..ElseIf.. ..Else..)

Bearbeiten

Über ElseIf können weitere Bedingungen mit entsprechenden Verzweigungen angefügt werden.

Sub WennSonntagSonstMsg()
   If Weekday(Date) = 1 Then
      MsgBox "Heute ist Sonntag"
   ElseIf Weekday(Date) = 7 Then
      MsgBox "Heute ist Samstag"
   Else
      MsgBox "Heute ist " & Format(Weekday(Date), "dddd")
   End If
End Sub

Zweckmäßig ist diese Struktur auch bei der Fehlerprüfung, wenn völlig unterschiedliche Bedingungen geprüft werden sollen:

Public Function DiscoEinlass(GeburtsTag As Date) As Boolean
    DiscoEinlass = False
    
    If DateSerial(Year(GeburtsTag) + 18, Month(GeburtsTag), Day(GeburtsTag)) > Date Then
        MsgBox "Sie sind leider noch nicht volljährig"
    ElseIf Year(Date) - Year(GeburtsTag) > 65 Then
        MsgBox "Rentner dürfen hier nicht rein!"
    ElseIf Weekday(GeburtsTag, vbSunday) <> 1 Then
        MsgBox "Sie sind kein Sonntagskind und können keine Elfen sehen"
    Else
        DiscoEinlass = True
    End If
End Function


Select-Case-Verzweigung

Bearbeiten

Bei mehr als zwei Bedingungen empfiehlt sich meist - wenn möglich - die Select-Case-Prüfung einzusetzen. Der vorliegende Fall wird eingelesen und danach schrittweise auf seinen Wahrheitsgehalt geprüft.

Sub PruefeFallMsg()
   Select Case Weekday(Date)
      Case 1, 7: MsgBox "Heute ist kein Arbeitstag"
      Case 2: MsgBox "Heute ist Montag"
      Case 3: MsgBox "Heute ist Dienstag"
      Case 4: MsgBox "Heute ist Mittwoch"
      Case 5: MsgBox "Heute ist Donnerstag"
      Case 6: MsgBox "Heute ist Freitag"
   End Select
End Sub

Sehr zweckmäßig ist die Select Anweisung auch, wenn man Optionsfelder in einem Formular (hier mit Objektbezeichner Me angesprochen) auswerten möchte. Dazu dreht man die Vergleichsbedingung um, so dass der konstante Teil des Vergleichs (hier True) hinter der Select Case Anweisung steht:

Sub ZeigeOption()
    Select Case True
        Case Me.Option1.Value: MsgBox "Option 1 gewählt"
        Case Me.Option2.Value: MsgBox "Option 2 gewählt"
        Case Me.Option3.Value: MsgBox "Option 3 gewählt"
        Case Me.Option4.Value: MsgBox "Option 4 gewählt"
        Case Else:             MsgBox "Nichts gewählt"
    End Select
End Sub

Sehr zweckmäßig ist die Select Anweisung auch, wenn man mehrere Bereiche zuordnen möchte, hierzu ist dies mit dem Operator "to" einfach möglich:

Sub Quartal()
    Select Case Month(Date)
    Case 1, 2, 3:   Quartal = 1
    Case 4 to 6:    Quartal = 2
    Case 7 to 9:    Quartal = 3
    Case 10 to 12:  Quartal = 4
    Case Else
        MsgBox "Dieser Fall tritt nicht ein."
    End Select
End Sub


Grundsätzlich sollte der häufigste Fall für eine Verzweigung mit der ersten CASE-Anweisung abgefangen werden, um die Laufzeit bei häufigen Aufrufen zu reduzieren.

Inline Verzweigungen mit IIf()

Bearbeiten

Für besonders einfache Fälle gibt es auch die Möglichkeit, Verzweigungen in einer Zeile zu erstellen. Die IIf() Funktion ist dabei das Pendant zur IF..Then..Else..End If Struktur. Die folgende Funktion baut einen Text mit einer IIf()-Funktion zusammen:

Public Function GeradeOderUngerade(Zahl As Long) As String
    GeradeOderUngerade = "Die Zahl ist eine " & IIf(Zahl Mod 2 = 0, "gerade", "ungerade") & " Zahl"
End Function

Diese Form der Verzweigung hat zwei besondere Merkmale:

  • Es muss für beide Antwortmöglichkeiten ein Ergebnis angegeben werden
  • Die beiden Teile werden unabhängig vom Ergebnis des Vergleichs immer beide ausgeführt. Dies ist zu beachten, falls Funktionen aufgerufen werden.

Das folgende Beispiel illustriert das Problem:

Public Function Division(Dividend As Double, Divisor As Double) As Double
    Division = IIf(Divisor = 0, 0, Dividend / Divisor)
End Function

Eigentlich sollte man im vorhergehenden Beispiel davon ausgehen, dass im Falle einer Division durch 0 (z.B. bei Aufruf von =Division(2,0) in einem Tabellenblatt) in dieser speziellen Funktion eine 0 zurückgegeben wird, statt dass ein Fehler die Ausführung unterbricht. Da aber stets alle Teile der IIf()-Verzweigung ausgeführt werden, probiert VBA auch die Division durch 0 und die ganze Funktion bricht mit einem Fehler ab.

Inline Verzweigungen mit Choose()

Bearbeiten

Das Inline Pendant zur Select Case Struktur ist die Choose() Funktion. Das folgende Beispiel zeigt, wie man in einer Zeile dem Datum einen Wochentag zuordnet:

Public Function Wochentag(Datum As Date) As String
    Wochentag = Choose(Weekday(Datum, vbMonday), "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So")
End Function

Hier gilt wie bei IIf(), dass alle Ausdrücke von VBA ausgeführt werden, egal wie das Ergebnis des Vergleichs ist.

Wann sollte welche Verzweigung gewählt werden?

Bearbeiten

Die vermutlich größte Schwierigkeit besteht, falls die Wahl zwischen IF..Then..ElseIf und Select Case besteht:

  • Select Case setzt voraus, dass ein Ausdruck eines Vergleiches mit allen anderen verglichen wird, und der sollte in der Zeile mit Select Case auftauchen. Damit eignet es sich beispielsweise zur Abfrage von Optionsfeldern (siehe Beispiel oben), zur Abfrage von Bereichen oder wenn eine Funktion wie MsgBox mehr als zwei verschiedene Rückgabewerte hat.
  • If..Then..ElseIf erlaubt es, völlig unterschiedliche Vergleiche auszuführen. If..Then..ElseIf eignet sich beispielsweise für Plausibilitätsabfragen am Anfang einer Funktion. Hier werden die Eingabedaten auf oft völlig unterschiedliche Kriterien geprüft, aber wenn nur eines erfüllt ist, gibt es eine spezielle Fehlermeldung.

Kombination von Schleifen und Wenn-Bedingungen

Bearbeiten


Erste leere Zelle ermitteln

Bearbeiten

Es wird zuerst geprüft, ob Zelle A1 einen Wert besitzt. Wenn nein, wird die Prozedur verlassen. Danach wird der Zeilenzähler initialisiert. Es folgt eine Schleife über alle Zellen in Spalte A, bis die erste leere Zelle erreicht wird. Die Adresse der ersten leeren Zelle wird in einer MsgBox ausgegeben.

Sub GeheBisLeer()
   Dim intRow As Integer
   If IsEmpty(Range("A1")) Then Exit Sub
   intRow = 1
   Do Until IsEmpty(Cells(intRow, 1))
      intRow = intRow + 1
   Loop
   MsgBox "Letzte Zelle mit Wert: " & _
      Cells(intRow - 1, 1).Address(False, False)
End Sub

UserForm-Optionsfeld nach Tageszeit aktivieren

Bearbeiten

Über die SelectCase-Anweisung wird die aktuelle Stunde bestimmt und hierüber die Tageszeit bzw. das entsprechende Optionsfeld aktiviert. Die Prozedur kommt in das Klassenmodul der UserForm.

Private Sub UserForm_Initialize()
   Select Case Hour(Time)
      Case Is > 18: optAbend.Value = True
      Case Is > 12: optMittag.Value = True
      Case Is > 6: optMorgen.Value = True
   End Select
End Sub

Aktiviertes UserForm-Optionsfeld ermitteln

Bearbeiten

Es wird zuerst eine Objektvariable für das Control-Objekt initialisiert. Danach werden alle Controls der UserForm durchlaufen. Treffen die Bedingungen, dass es sich um ein Optionsfeld handelt und dass es aktiviert ist zu, dann wird eine entsprechende Meldung ausgegeben und die Schleife beendet.

Private Sub cmdWert_Click()
   Dim cnt As Control
   For Each cnt In Controls
      If Left(cnt.Name, 3) = "opt" And cnt.Value = True Then
         MsgBox "Optionsfeld " & cnt.Name & " ist aktiviert!"
         Exit Sub
      End If
   Next cnt
End Sub

Schleifen und Matrizen

Bearbeiten



Matrizen in VBA werden als Arrays bezeichnet. Grundsätzlich gibt es mehrere Möglichkeiten, ein Array zu erzeugen:

  • Über Dim als Datenfeld, z.B. ergibt die Anweisung Dim Matrix(1 To 3, 1 To 3) eine 3 × 3-Matrix mit der mathematisch richtigen Indizierung der Zeilen und Spalten jeweils von 1..3
  • An eine Variable vom Typ Variant kann ein Array aus einer anderen Variablen zugewiesen werden
  • Über die Anweisung array() kann an eine Variable vom Typ Variant ein Array zugewiesen werden, z.B. mit Var1D = array(11,12,13); Auf diese Art ist es auch möglich, ein zweidimensionales Array anzulegen, z.B. durch Var2D = array(array(11, 12), array(21, 22)); Arrays höherer Dimensionen lassen sich auf vergleichbare Weise anlegen.

Arrays können auch als Rückgabewert einer benutzerdefinierten Funktion definiert werden. Wenn eine benutzerdefinierte Funktion eine 2 × 2-Matrix in ein Tabellenblatt zurückgeben soll, muss auf dem Tabellenblatt zuerst ein Bereich mit 2 × 2 Zellen markiert werden, dann tippt man die Funktion ein und schließt die Eingabe wie bei einer Matrixformel mit Umschalt+Strg+Eingabe ab.

Das Array lässt sich leider nicht als Konstante (über Const) speichern - weder in einer Prozedur/Funktion noch im Deklarationsteil eines Moduls.


Arrays in VBA

Bearbeiten

Das erste Beispiel prüft, ob eine Zahl durch eine Gruppe von anderen Zahlen teilbar ist - falls nicht, wird die Zahl selbst zurückgegeben. Der Vorteil bei dieser Schreibweise mit einem array() ist, dass das Programm zu einem späteren Zeitpunkt ohne besondere Kenntnisse des Codes erweitert werden kann, indem man der TeilerListe einfach noch ein paar Zahlen anhängt:

Public Function TeilerGefunden(Zahl As Long) As Long
    Dim TeilerListe As Variant  ' Liste der Primteiler
    Dim Teiler      As Variant  ' Schleifenvariable
    
    TeilerListe = Array(2, 3, 5, 7, 11, 13)
    TeilerGefunden = Zahl
    
    For Each Teiler In TeilerListe
        If Zahl Mod Teiler = 0 Then
            TeilerGefunden = Teiler
            Exit Function
        End If
    Next Teiler
End Function

Das nächste Beispiel nutzt folgende Eigenschaften in Excel: Tabellenblätter haben nicht nur einen Namen (Eigenschaft .Name), der auf der Registerkarte sichtbar ist, sondern auch einen Objektnamen (Eigenschaft .CodeName), der nur im Projekt-Explorer des VBA-Editors sichtbar ist und auch dann unverändert bleibt, wenn der Benutzer das Blatt umbenennt. Das deutsche Excel legt diesen Namen (.CodeName) standardmäßig wie den Blattnamen (.Name) an, aber -wie geschrieben- ändert er sich .CodeName nicht mehr bei einer Umbenennung des Blattes.

In diesem Falle enthält die Arbeitsmappe zwei Blätter, die als Objekte mit Tabelle1 und Tabelle2 angesprochen werden können. Die Prozedur bestimmt die Anzahl der benutzten Zellen in jedem Blatt und zeigt sie an:

Public Sub BelegungTabellenblätter()
    Dim ListeAllerTabellen  As Variant ' Liste aller Tabellen
    Dim Tabelle             As Variant ' Schleifenvariable
    
    ListeAllerTabellen = Array(Tabelle1, Tabelle2) ' Zuweisung des Objektarrays
    
    For Each Tabelle In ListeAllerTabellen
        MsgBox "Tabelle " & Tabelle.Name & " hat " & _
                Tabelle.UsedRange.Cells.Count & " belegte Zellen"
    Next Tabelle
End Sub

Dieses Beispiel zeigt also, dass das array() auch Objekte aufnehmen kann. Auch hier bietet sich wieder die einfache Möglichkeit, den Code später einfach von Hand zu ergänzen.

Eindimensionale vordimensionierte Matrix füllen

Bearbeiten

Eine dimensionierte eindimensionale Matrix wird mit der Zählvariablen gefüllt und danach werden die Werte per MsgBox ausgegeben.

Sub FuellenMatrixEinfach()
   Dim arrNumbers(1 To 3) As Integer
   Dim intCounter As Integer
   For intCounter = 1 To 3
      arrNumbers(intCounter) = intCounter
   Next intCounter
   For intCounter = 1 To UBound(arrNumbers)
      MsgBox arrNumbers(intCounter)
   Next intCounter
End Sub

Eindimensionale Matrix mit vorgegebenem Wert dimensionieren und füllen

Bearbeiten

Die Matrix wird auf die Hälfte der Anzahl der Zeilen der mit A1 verbundenen Zellen dimensioniert. Danach werden die Zellinhalte jeder zweiten Zelle der ersten Spalte in die Matrix eingelesen und über eine MsgBox wieder ausgegeben.

Sub FuellenMatrixSingle()
   Dim arrCells() As String
   Dim intCounter As Integer, intCount As Integer, intArr As Integer
   Dim strCell As String
   intCount = Range("A1").CurrentRegion.Rows.Count / 2
   ReDim arrCells(1 To intCount)
   For intCounter = 1 To intCount * 2 Step 2
      intArr = intArr + 1
      arrCells(intArr) = Cells(intCounter, 1)
   Next intCounter
   For intCounter = 1 To UBound(arrCells)
      MsgBox arrCells(intCounter)
   Next intCounter
End Sub

Mehrdimensionale Matrix füllen

Bearbeiten

Der mit der Zelle A1 zusammengehörige Bereich wird in eine Matrix ein- und eine einzelne Zelle über MsgBox wieder ausgelesen.

Sub FuellenMatrixMulti()
   Dim arrJahr As Variant
   arrJahr = Range("A1").CurrentRegion
   MsgBox arrJahr(3, 2)
End Sub

Das folgende Beispiel zeigt, wie man den markierten Bereich im aktiven Tabellenblatt ausliest. Die Funktion geht die Auswahl im Tabellenblatt Zeile für Zeile und dann Spalte für Spalte durch. Jeder gefundene Wert wird in ein Element der Variablen Matrix gespeichert. Diese ist dann der Rückgabewert der Funktion MatrixFüllen():

Public Function MatrixFüllen() As Double()
    Dim ZeileNr     As Long     ' Zeilenzähler
    Dim SpalteNr    As Long     ' Spaltenzähler
    
    Dim Matrix()    As Double   ' Matrix
    
    ' Matrix auf Zeilen- und Spaltenzahl der Auswahl bringen
    ' Dabei soll jeder Index bei 1 beginnen
    ReDim Matrix(1 To Selection.Rows.Count, 1 To Selection.Columns.Count)
    
    ' Auswahl zeilenweise lesen
    For ZeileNr = 1 To Selection.Rows.Count
        ' Auswahl spaltenweise lesen
        For SpalteNr = 1 To Selection.Columns.Count
            With Selection.Cells(ZeileNr, SpalteNr)
                If IsNumeric(.Value) Then
                    ' Matrix elementweise füllen
                    Matrix(ZeileNr, SpalteNr) = .Value
                Else
                    ' Fehlermeldung ausgeben
                    MsgBox "Zelle " & .Address & " enthält keine Zahl"
                    Exit Function
                End If
            End With
        Next SpalteNr
    Next ZeileNr
    
    ' Rückgabewert der Funktion
    MatrixFüllen = Matrix
End Function

Die Funktion MatrixFüllen() erstellt die Größe der Matrix anhand der Markierung dynamisch und weist den Inhalt der Matrix dem Rückgabewert der Funktion zu. Zur dynamischen Dimensionierung gehört im Beispiel auch, dass der Index der Matrix mit 1 beginnend definiert wird (mathematische Notation), ohne diese Angabe würde Excel gewohnheitsmäßig die Indizes bei 0 beginnen lassen. Falls eine Zelle keine Zahl enthält, erscheint eine Fehlermeldung. Leere Zellen werden als 0 interpretiert.

Variablen und Arrays

Bearbeiten


Grundlegendes

Bearbeiten

Was sind Variablen?

Variablen sind eine Art von Platzhalter für Zeichenfolgen, Werte und Objekte. So können beispielsweise mehrfach anzuzeigende Meldungen, bei Berechnungen mehrfach einzusetzende Werte oder in einer Schleife anzusprechende Objekte in Variablen gespeichert werden.

Wann sind Variablen einzusetzen?

Der Einsatz von Variablen ist immer dann sinnvoll, wenn das Element mehrfach angesprochen wird. Sinnvoll eingesetzt, beschleunigen Variablen die Ausführung eines VBA-Programms erheblich. Wird das Element im Code nur einmal angesprochen – wie zum Beispiel eine Msg-Meldung – ist das Speichern dieser Zeichenfolge in eine String-Variable überflüssig und verwirrend. Ausnahmen bilden Fälle, in denen auch bei einmaligem Vorkommen die Übersichtlichkeit des Codes verbessert wird. Dies kann beispielsweise bei langen Objektnamen der Fall sein.

Sind Variablen zu deklarieren?

Eine Deklaration der Variablen sollte immer erfolgen (siehe auch Variablendeklaration). Dazu sollte in der Entwicklungsumgebung im Menü Extras / Optionen die CheckBox Variablendeklaration erforderlich aktiviert sein. VBA-Anweisungen zur Deklarierung sind:

  • Dim
    • In einer Function oder Sub Anweisung. Die Deklaration sollte am Anfang stehen
    • Zu Beginn eines (Standard-)Moduls oder Klassenmoduls, ist gleichwertig mit Public Dim
  • Private: Am Anfang eines (Standard-)Moduls oder Klassenmoduls, bedeutet Private Dim (nicht zulässig)
  • Global entspricht Public, aus Gründen der Abwärtskompatibilität unterstützt

Empfehlenswert ist ein Kommentar in der Zeile vor der Variablendeklaration oder in der Zeile der Deklaration am Ende, um den Zweck der Variablen zu erklären. Beispiel:

  Private i As Integer ' Schleifenzähler

Wo sind Variablen zu deklarieren?

Variablen, die nur für die Prozedur gelten sollen, sind innerhalb der Prozedur, in der Regel am Prozeduranfang zu deklarieren. Variablen, die außerhalb einer Prozedur deklariert werden, gelten für das ganze Modul, werden sie als Public deklariert, für das gesamte Projekt. Zu einem sauberen Programmierstil gehört es, Variablen soweit irgend möglich nur auf Prozedurebene zu deklarieren und an Unterprogramme als Parameter zu übergeben.

Sind Variablen zu dimensionieren?

Wenn Variablen als Array deklariert wurden, z.B. Dim MitgliedsNr() As Long können sie entweder mit der Deklaration dimensioniert werden (Dim MitgliedsNr(1001) As Long oder Dim MitgliedsNr(1 To 1000) As Long oder nachträglich mit der ReDim-Anweisung

Sind Objekttyp-Variablen bestimmten Objekten zuzuweisen?

Zur Referenzierung von Objekten durch Variable kann stets der allgemeine Typ Variant (nicht empfehlenswert), als auch der allgemeine Objekttyp Object verwendet werden. Wenn die Bibliothek des Objekts über das Menü 'Extras' 'Verweise' eingebunden ist, kann auch der spezielle Objekttyp deklariert werden. Zu bevorzugen ist immer eine möglichst genaue Deklaration, die Deklaration des spezifischen Objekttyps bietet vor allem diese Vorteile:

  • Schnellerer Programmablauf
  • Weniger Speicherbedarf als bei Variant
  • In der Entwicklungsumgebung werden während der Programmierphase - wenn im obigen Dialog die CheckBox Elemente automatisch auflisten aktiviert ist - beim Eintippen des Punktes nach einem Objektnamen alle Methoden und Eigenschaften automatisch aufgelistet, was Fehler vermeidet und Schreibarbeit erspart.
  • Fehlermeldungen schon beim Kompilieren (falls beispielsweise Argumente fehlerhaft sind), genauere Fehlerbeschreibungen

Konstanten

Bearbeiten

Konstanten werden hier der Vollständigkeit halber erwähnt. Weisen Sie immer dann, wenn ein Wert vom Programmstart bis zum Programmende unverändert bleibt, diesen einer Konstanten, keiner Variablen zu. Konstanten werden in VBA-Programmen schneller verarbeitet als Variablen. Konstanten werden generell im Allgemein-Abschnitt von Modulen deklariert, Private-Konstanten in Klassen- und Standard-, Public-Konstanten nur in Standardmodulen. Beispiel für eine Konstanten-Deklaration:

Private Const cintStart As Integer = 5

Variablentypen

Bearbeiten

Die gebräuchlichen Variablentypen:

Variablentyp Namenskonvention Res.Speicherplatz Kurzbezeichnung Dezimalstellen
Boolean bln 16 Bit, 2 Bytes   -
Byte 8 Bit, 1 Byte   -
Integer int 16 Bit, 2 Bytes % -
Long lng 32 Bit, 4 Bytes & -
Currency cur   @ 32
Single sng 32 Bit, 4 Bytes ! 8
Double dbl 64 Bit, 8 Bytes # 16
Date dat 64 Bit, 8 Bytes    
String str   $  
Object obj 32 Bit, 4 Bytes    
Variant var 128 Bit, 16 Bytes    
benutzerdefinierter Typ typ      
Objekttyp        


Variablentyp Beschreibung
Boolean  WAHR (-1) oder FALSCH  (0)
Byte 0 ... +255
Integer -32.768 ... +32.767
Long -2.147.483.648 ... +2.147.483.647
Currency -922.337.203.685.477,5808 ... +922.337.203.685.477,5807
Single  3,402823E38 ...  1,401298E-45 und 0
Double -1.79769313486231E308 bis -4,94065645841247E-324 für negative Werte und von 4,94065645841247E-324 bis 1,79769313486232E308 für positive Werte und 0
Date Datum und Zeit
String Zeichenfolgen (Text)
Object Objekte
Variant Alle Typen, Voreinstellung
benutzerdefinierter Typ ein oder mehrere Elemente jeden Datentyps. Der Aufbau wird mit einer Type-Anweisung deklariert
Objekttyp Objekte wie Workbook, Range

Anmerkungen zu den Variablentypen

Bearbeiten

Dieser Datentyp speichert eigentlich nur ein Bit, aus Gründen der Speicherorganisation wird jedoch stets ein Byte belegt. Die Werte von Boolean werden als 8-Bit Zahl dargestellt, wobei nur -1 (= alle Bits gesetzt bei Darstellung der -1 als Zweierkomplement) als WAHR gilt, jeder andere Wert aber als FALSCH. Speziell bei Vergleichen wird das Ergebnis FALSCH als 0 (= kein Bit gesetzt) zurückgegeben.

In Kenntnis dieser Interpretation kann der Programmierer Vergleiche auch direkt auf Zahlenwerte in Long-, Integer- und Byte-Datentypen (bei letzteren setzt der Wert 255 alle Bits) anwenden. Aus Gründen der Lesbarkeit des Codes sollte das aber vermieden werden.

Bei diesem Variablentyp ist in speziellen Fällen Vorsicht geboten, beispielsweise kann bei

For i = 10 To 0 Step -1

dieser Schleifenkonstruktion ein Unterlauf-Fehler auftreten, wenn i als Byte dimensioniert wird, weil in der internen Berechnung auch noch -1 berechnet wird. Wird als Endwert der Schleife 1 statt 0 angegeben oder wird beispielsweise der Datentyp Integer für i verwendet, gibt es kein Problem.

Der Typ speichert das Datum in zwei Teilen:

  • Vor dem Komma steht die fortlaufende Tagesnummer. Tag 0 dieser Zählung ist der 31.12.1899; Bei der Anzeige wird es in die vom System eingestellte Darstellung von Tag, Monat und Jahr umgerechnet.
  • Nach dem Komma stehen die Anteile des Tages. 0,25 steht für 6 Stunden, 0,5 für 12 h usw.

Vom Wert her ist der Inhalt dieses Datentyps nicht von einem Fließkommawert zu unterscheiden. Entsprechend einfach können Tage und Stunden addiert werden, hier einige Beispiele:

  • Um zu einem Datum h Stunden zu addieren, rechnet man Datum + h/24
  • Um zu einem Datum h Stunden und m Minuten zu addieren, rechnet man Datum + h/24 + m/(24*60) oder Datum + (h + m/60)/24
  • Um zu einem Datum h Stunden und m Minuten und s Sekunden zu addieren, rechnet man Datum + (h + (m + s/60)/60)/24

Currency

Bearbeiten

Der Datentyp ist ein Festkommaformat mit vier Nachkommastellen. Daher wird er intern wie eine Ganzzahl berechnet. Wenn die Genauigkeit ausreicht, kann mit der Wahl dieses Datentyps gegenüber Single und Double die Berechnung schneller erfolgen. Bei Kettenrechnungen mit langen oder periodischen Dezimalteilen ist allerdings mit einem Genauigkeitsverlust zu rechnen.

Der Datentyp speichert Zeichen mit variabler Länge von maximal 231 Zeichen.

Für bestimmte Zwecke können auch Strings mit fester Länge sinnvoll sein. Sie können mit einem * definiert werden, Beispiel String mit der festen Länge 3:

    Public Sub Demo_StringMitFesterLänge()
        Dim ZeichenKette As String * 3
        ZeichenKette = "A"
        MsgBox ">" & ZeichenKette & "<"
    End Sub

Bei der Zuweisung von "A" wird der String von links belegt, die übrigen Zeichen werden mit einem Leerzeichen aufgefüllt. Die Strings mit fester Länge unterliegen gewissen Einschränkungen, so können sie max. 216 Zeichen speichern und nicht mit dem Attribut Attribut Public in Klassenmodulen verwendet werden.

Benutzerdefinierte Typen

Bearbeiten

Diese Typen werden aus den Grundtypen mit Hilfe der Type-Anweisung zusammengesetzt. Das folgende Beispiel zeigt, wie die Typdeklaration für komplexe Zahlen aussehen könnte. Neben dem Real- und Imaginärteil wird in dem benutzerdefinierten Typ auch gespeichert, ob die komplexe Zahl in kartesischen Koordinaten (FALSE) oder in Polarkoordinaten (TRUE) abgelegt wurde.

Das Beispiel des komplexen Multiplikationsprogramms cMult wurde nur für den Fall ausgeführt, in dem beide Variablen in kartesischen Koordinaten vorliegen.

    Type Komplex            ' Komplexe Zahl
       Re      As Double    ' Realteil
       Im      As Double    ' Imaginärteil
       Winkel  As Boolean   ' FALSE = Kartesisch, TRUE = Polar
    End Type
    

    ' ** Funktion zur Multiplikation zweier komplexer Zahlen
    Public Function cMult(a As Komplex, b As Komplex) As Komplex
        If (a.Winkel = b.Winkel) Then
            ' Beide Zahlen liegen im gleichen Koordinatensystem vor
            If Not a.Winkel Then
                ' Beide Zahlen liegen in kartesischen Koordinaten vor
                ' Multiplikation in kartesischen Koordinaten
                cMult.Re = a.Re * b.Re - a.Im * b.Im
                cMult.Im = a.Im * b.Re + a.Re * b.Im
                cMult.Winkel = a.Winkel
           End If
        End If
    End Function

Das folgende Beispiel zeigt zwei Möglichkeiten, um die Variablen Faktor1 und Faktor2 mit Werten zu belegen und wie man das Ergebnis der Funktion cMult im weiteren Programmlauf verwerten kann:

    Public Sub Demo_KomplexeMultiplikation()
        Dim Faktor1  As Komplex  ' Erster Faktor
        Dim Faktor2  As Komplex  ' Zweiter Faktor
        Dim Ergebnis As Komplex  ' Komplexes Produkt
        
        ' Möglichkeit 1.1: Variable mit Hilfe der With-Anweisung belegen
        With Faktor1
            .Re = 2
            .Im = 3
            .Winkel = False
        End With
    
        ' Möglichkeit 1.2: Direkt belegen
        Faktor2.Re = 5
        Faktor2.Im = 7
        Faktor2.Winkel = False
        
        ' Möglichkeit 2.1: Ergebnis einer Variablen vom Typ Komplex zuweisen
        Ergebnis = cMult(Faktor1, Faktor2)
        
        ' Ausgabe ins Direktfenster
        Debug.Print Ergebnis.Re, Ergebnis.Im, Ergebnis.Winkel
        
        ' Möglichkeit 2.2: Alle Werte einzeln aus dem Rückgabewert der Funktion holen
        With cMult(Ergebnis, Faktor2)
            MsgBox Iif(.Winkel, "R: ", "x-Koordinate: ") & .Re
            MsgBox Iif(.Winkel, "Winkel: ", "y-Koordinate: ") & .Im
        End With
    End Sub

Der Einfachheit halber wurden die Rückgabewerte mit Debug.Print in das Direktfenster geschrieben.

Variablendeklaration

Bearbeiten

Wie schon erwähnt, sind Variablen generell zu deklarieren und zu dimensionieren. Werden sie nicht deklariert oder nicht dimensioniert, handelt es sich beim Programmstart in jedem Fall um den Variablentyp Variant, der zum einen mit 16 Bytes den größten Speicherplatz für sich beansprucht, zum anderen während des Programmablaufes seinen Typ mehrmals wechseln kann, was möglicherweise zu unerwarteten Verhalten und damit Fehlern führen kann. Außerdem benötigen Variant-Variablen erheblich längere Berechnungszeiten als andere.

Einsatz von String-Variablen

Bearbeiten

Im nachfolgenden Beispiel wird eine String-Variable deklariert und zum Finden und Ersetzen einer Zeichenfolge eingesetzt:

Sub Ersetzen()
   Dim rngCell As Range
   Dim strText As String
   strText = "Kasse "
   strYear = CStr(Year(Date))
   For Each rngCell In Range("A1:F15")
      If rngCell.Value = strText & Year(Date) - 1 Then
         rngCell.Value = strText & Year(Date)
      End If
   Next rngCell
End Sub

Im vorgegebenen Bereich werden alle Zellen darauf überprüft, ob ihr Text aus der Zeichenfolge Kasse und der Jahreszahl des Vorjahres besteht. Wenn ja, wird die Vorjahreszahl durch die aktuelle Jahreszahl ersetzt. String-Variablen sollten mit dem &-Zeichen verknüpft werden. Strings können auch mit + verknüpft werden. Dies funktioniert aber nur zuverlässig, wenn beide Variablen oder Ausdrücke strings sind. Falls ein Ausdruck numerisch ist und der andere ein String, der als Zahl interpretierbar ist, nimmt Excel eine Typumwandlung vor und liefert als Ergebnis die algebraische Summe der beiden Ausdrucke. Wenn in einem Ausdruck & mit + gemischt wird, berechnet VBA zuerst + (und alle anderen algebraischen Operationen wie -*/) dann erst &;

Beispiele:

  • Aus "2" + "3" wird "23"
  • Aus "2" + 3 wird 5
  • Aus "2" & 3 wird "23"
  • Aus "2" & 3 + 4 & "5" wird 275
  • Aus "2" & 3 & 4 & "5" wird 2345
  • Aus "2" + 3 & 4 + "5" wird 59

Einsatz von Variant-Variablen

Bearbeiten

Es gibt Fälle, in denen eine Variable ihren Typ ändert oder unterschiedliche Typen entgegennehmen muss. In diesem Fall können Variant-Variablen eingesetzt werden. Dies ist besonders dann notwendig, wenn eine Funktion unterschiedliche Datentypen zurückgeben kann, wie z.B. GetOpenFilename. Diese liefert entweder einen String als Pfadangabe oder den booleschen Wert FALSE, wenn in dem von ihr geöffneten Dialog die Schaltfläche 'Abbrechen' betätigt wurde:

Sub Oeffnen()
   Dim varFile As Variant
   varFile = Application.GetOpenFilename("Excel-Dateien (*.xls), *.xls")
   If varFile = False Then Exit Sub
   Workbooks.Open varFile
End Sub

Ein anderes Beispiel ist die Funktion IsMissing, mit der geprüft werden kann, ob einer Funktion ein optionales Argument übergeben wurde:

Public Sub EingabeMöglich(Optional Wert As Variant)
    If IsMissing(Wert) Then
        MsgBox "Kein Argument übergeben"
    Else
        MsgBox Wert
    End If
End Sub

Falls das übergebene Argument in (Optional Wert As String) geändert wird, funktioniert IsMissing() nicht mehr und das Programm durchläuft immer den Else-Zweig.

Einsatz von Public-Variablen

Bearbeiten

Im nachfolgenden Beispiel wird in einem Standardmodul eine Public-String-Variable deklariert. Diese wird in der Prozedur AufrufenMeldung mit einem Wert belegt; danach wird das Unterprogramm Meldung aufgerufen. Da die Variable außerhalb der Prozeduren deklariert wurde, ist der Wert nicht verlorengegangen und kann weiterverwertet werden.

Public strMsg As String

Sub AufrufenMeldung()
    strMsg = "Hallo!"
    Call Meldung
End Sub

Sub Meldung()
    MsgBox strMsg
End Sub

Auch wenn sich die Prozedur Meldung in einem anderen Modul befindet, funktioniert der Aufruf. Erfolgt jedoch die Deklaration mit Dim oder als Private, gilt sie nur für das jeweilige Modul.

Übergabe von String-Variablen

Bearbeiten

Eine Vorgehensweise wie im vorhergehenden Beispiel ist zu meiden und eine Übergabe der Variablen als Parameter ist vorzuziehen:

 Sub AufrufenMeldung()
     Dim strMsg As String
     strMsg = "Hallo!"
     Call Meldung(strMsg)
 End Sub
 
 Sub Meldung(strMsg As String)
     MsgBox strMsg
 End Sub

Variablen in Funktionen

Bearbeiten

Funktionen werden eingesetzt, wenn Werte zurückgeliefert werden müssen. Eine Alternative wäre (neben einer ByRef-Variablenübergabe) der Einsatz von Public-Variablen, die wir ja meiden wollen. Bei den Parametern einer Funktion handelt es sich ebenfalls um Variablen. Der Deklarationsbereich liegt innerhalb der Klammern der Funktion. Diese Parameter müssen beim Aufruf der Funktion - aus einem Tabellenblatt oder aus einer anderen Prozedur - übergeben werden. In der nachfolgenden Funkion wird die Kubatur errechnet:

Function Kubatur( _
   dblLaenge As Double, _
   dblBreite As Double, _
   dblHoehe As Double) As Double
   Kubatur = dblLaenge * dblBreite * dblHoehe
End Function

Die Eingabesyntax einer solchen Prozedur in einem Tabellenblatt ist, wenn die Werte in den Zellen A1:C1 stehen:

=kubatur(A1;B1;C1)

Wird die Funktion aus einer anderen Prozedur zur Weiterverarbeitung aufgerufen, sieht das wie folgt aus:

Sub ErrechneGewicht()
   Dim dblSpezGewicht As Double, dblKubatur As Double
   dblSpezGewicht = 0.48832
   dblKubatur = Kubatur(Range("A1"), Range("B1"), Range("C1"))
   Range("E1").Value = dblKubatur * dblSpezGewicht
End Sub

Hierarchische Anordnung der Objekttyp-Variablen

Bearbeiten

Über die Objekttypvariablen kann ein Typengerüst aufgebaut werden, indem die jeweils aktuelle Ebene referenziert wird:

Sub NeueSymbolleiste()
   Dim objCmdBar As CommandBar
   Dim objPopUp As CommandBarPopup
   Dim objButton As CommandBarButton
   Dim intMonth As Integer, intDay As Integer
   On Error Resume Next
   Application.CommandBars("Jahr " & Year(Date)).Delete
   On Error GoTo 0
   Set objCmdBar = Application.CommandBars.Add("Jahr " & Year(Date), msoBarTop)
   For intMonth = 1 To 12
      Set objPopUp = objCmdBar.Controls.Add(msoControlPopup)
      objPopUp.Caption = Format(DateSerial(1, intMonth, 1), "mmmm")
      For intDay = 1 To Day(DateSerial(Year(Date), intMonth + 1, 0))
         Set objButton = objPopUp.Controls.Add
         With objButton
            .Caption = Format(DateSerial(Year(Date), intMonth, intDay), _
               "dd.mm.yy - dddd")
            .OnAction = "MeldenTag"
            .Style = msoButtonCaption
         End With
      Next intDay
   Next intMonth
   objCmdBar.Visible = True
End Sub

Mit vorstehendem Code wird eine neue Symbolleiste mit dem Namen des aktuellen Jahres angelegt und im Symbolleistenbereich als nächstuntere platziert. Der Leiste wird für jeden Monat ein Menü und diesem Menü wird für jeden Tag eine Schaltfläche hinzugefügt.

Das Auslesen der betätigten Schaltfläche und die Datumsberechnungen erfolgen anhand einer Datumsvariablen:

Private Sub MeldenTag()
    Dim datAC As Date
    datAC = DateSerial(Year(Date), Application.Caller(2), Application.Caller(1))
    Select Case datAC
        Case Is < Date
            MsgBox Date - datAC & " Tage vergangen"
        Case Is = Date
            MsgBox "Heute"
        Case Is > Date
            MsgBox "Noch " & datAC - Date & " Tage"
    End Select
End Sub

Collections von Objekttyp-Variablen

Bearbeiten

Das Objekt UserForm1.Controls stellt alle Steuerelemente dar, die in der UserForm1 enthalten sind. Nicht ganz so einfach ist es, auf alle CheckBoxes dieser UserForm zuzugreifen, um sie über eine Schleife zu bearbeiten, denn die CheckBox ist kein gültiges Objekt, das heißt Controls. Liest man die CheckBoxes in ein Collection-Objekt ein, lassen Sie sich später problemlos ansprechen und in Schleifen einbinden:

Public colChBox As New Collection 

Private Sub UserForm_Initialize()
   Dim cnt As Control, intMonth As Integer
   For Each cnt In Controls
      If TypeName(cnt) = "CheckBox" Then
         intMonth = intMonth + 1
         colChBox.Add cnt
         cnt.Caption = Format(DateSerial(1, intMonth, 1), "mmmm")
      End If
   Next cnt
End Sub

Das Collection-Objekt wird - damit es seinen Wert nicht verliert - als Public außerhalb einer Prozedur deklariert und im Initialisierungscode der UserForm mit den Einzelobjekten - den 12 CheckBoxes der UserForm - belegt. Beim Klick auf die Schaltfläche Meldung werden alle aktivieren CheckBoxes in einer MsgBox ausgegeben:

Private Sub cmdMeldung_Click()
   Dim intCounter As Integer
   Dim strMsg As String
   strMsg = "Aktiviert:" & vbLf
   For intCounter = 1 To 12
      If colChBox(intCounter).Value Then
         strMsg = strMsg & colChBox(intCounter).Caption & vbLf
      End If
   Next intCounter
   MsgBox strMsg
End Sub

Arrays und Feldvariablen

Bearbeiten

Es gibt grundsätzlich zwei Möglichkeiten, Variablen für Matrizen zu schaffen. Entweder man deklariert die Variable als Variant und weist ihr ein Array zu oder man deklariert sie als Datenfeld. Variant-Variablen können Datenfeldvariablen aufnehmen.

Beispiel

Dim Array(1 to 200) as integer
'Zuweisung von Werten
Array(1) = 1

Arrays im Code

Bearbeiten

Eine einfache Methode, um im Code ein Array von Konstanten zu verwenden, benötigt eine Variable vom Typ Variant, in die ein Array gespeichert wird. Beim folgenden Beispiel sollen ein paar Tabellen explizit ausgeblendet werden. Das macht z.B. beim Öffnen einer Datei Sinn, wenn man sicher sein will, dass bestimmte Informationen nicht sichtbar sind.

Public Sub BlätterAusblenden()
    Dim MeineTabellen As Variant, Tabelle As Variant
    MeineTabellen = Array("Tabelle1", "Tabelle3")

    On Error Resume Next
    
    For Each Tabelle In MeineTabellen
        Worksheets(Tabelle).Visible = False
    Next Tabelle
End Sub

Der Vorteil des Arrays liegt hier in der Übersichtlichkeit, denn wenn man den Code anpassen muss, hat man die Namen der Tabellen schön zusammengefasst. Das Array kann aber auch Objekte speichern, und das macht bei dieser Aufgabe einen besonderen Sinn. Die Namen der Tabellen können geändert werden, dann läuft das Programm ins Leere. In VBA haben alle Tabellen einen zweiten Namen, der über die Eigenschaft .CodeName ausgelesen werden kann und der im VBA-Code auch gleichzeitig das Tabellenobjekt benennt. Die Eigenschaft .CodeName kann man lesen, wenn man im VBA-Editor den Projekt-Explorer öffnet. Dort steht neben dem Codenamen der Tabelle in Klammern der Name des Tabellenblattes in Excel. Nur im VBA-Editor oder mit VBA lässt sich der Codename ändern, einfaches Umbenennen des Blattes in Excel wirkt sich nicht auf den CodeNamen aus.

Wenn eine Mappe erstellt wird oder ein leeres Blatt eingefügt wird, erhält sind Name und Codename erst mal gleich. Das setzen wir auch beim folgenden Beispiel voraus. Leider funktioniert die For-Each-Schleife nicht mehr so gut, daher muss die Schleifenstruktur mit einem Zähler aufgebaut werden. LBound() und UBound() ermitteln den kleinsten und den größten Index des Arrays.

Public Sub BlätterAusblenden()
    Dim MeineTabellen As Variant, i As Integer
    MeineTabellen = Array(Tabelle1, Tabelle3)

    On Error Resume Next
    
    For i = LBound(MeineTabellen) To UBound(MeineTabellen)
        MeineTabellen(i).Visible = False
    Next i
End Sub

Wie bereits geschrieben, Tabelle1 und Tabelle2 sind in diesem Beispiel keine Texte, Namen oder Variablen, sondern echte Objekte (nämlich zwei Tabellen), die ihren CodeNamen tragen.

Arrays mit mehreren Dimensionen

Bearbeiten

Den folgenden Beispielen liegt folgende Aufgabe zu Grunde: Markiere einen Bereich in einer Tabelle und starte ein Makro, welches von jeder Zelle in der Markierung drei Werte speichert:

  1. Die absolute Adresse
  2. Die Zellformel bzw. den Zellwert, wenn keine Formel in der Zelle steht
  3. Wahrheitswert (True/False), ob sich in der Zelle eine Formel oder ein Wert befand.

Das Array wird von dem Programm nicht weiter genutzt, aber das ist für diese Beispiele egal. Alle Lösungen erzeugen ein zweidimensionales Array.

  • Mit der ersten Dimension steuert man beim Lesen oder Schreiben, ob die Zelle im Array gerade die Adresse, den Inhalt oder den booleschen Wert enthält. Die erste Dimension hat daher nur die Werte 1, 2, 3
  • Die zweite Dimension ist die Zelle, sie läuft von 1 bis zur Anzahl der Zellen.
Public Sub DimensionsDemo1()
    Dim ZellInhalt() As String, Markierung As Range
    Dim ZelleNr As Long
    
    ' Bereich verkleinern, nur den benutzten Bereich bearbeiten
    Set Markierung = Intersect(Selection.Cells, Selection.Parent.UsedRange)
    
    ' Array auf die Größe des Bereiches setzen
    ReDim ZellInhalt(1 To 3, 1 To Markierung.Cells.Count)
    
    For ZelleNr = 1 To Markierung.Cells.Count
        With Markierung.Cells(ZelleNr)
            ' Adresse der Zelle speichern
            ZellInhalt(1, ZelleNr) = .Address(True, True, xlA1, True)
            
            ' Inhalt der Zelle speichern
            ZellInhalt(2, ZelleNr) = .Formula

            ' Speichern, ob die Zelle eine Formel / Wert enthielt
            ZellInhalt(3, ZelleNr) = .HasFormula
        End With
    Next ZelleNr
End Sub

Die nächste Lösung ist nur unwesentlich besser. Da man sich normalerweise die erste Dimension schlecht merken kann ("Was ist nun wieder 1, 2, oder 3?") kann man hier mit einer Aufzählung (Private Enum) nachhelfen. Die Aufzählung steht im Deklarationsbereich des Moduls.

' Definition einer Aufzählung
Private Enum InhaltsArt
    ddAdresse = 1
    ddInhalt = 2
    ddFormel = 3
End Enum

Public Sub DimensionsDemo2()
    Dim ZellInhalt() As String, Markierung As Range
    Dim ZelleNr As Long
    
    ' Bereich verkleinern, nur den benutzten Bereich bearbeiten
    Set Markierung = Intersect(Selection.Cells, Selection.Parent.UsedRange)
    
    ' Array auf die Größe des Bereiches setzen
    ReDim ZellInhalt(1 To 3, 1 To Markierung.Cells.Count)
    
    For ZelleNr = 1 To Markierung.Cells.Count
        With Markierung.Cells(ZelleNr)
            ' Adresse der Zelle speichern
            ZellInhalt(ddAdresse, ZelleNr) = .Address(True, True, xlA1, True)
            
            ' Inhalt der Zelle speichern
            ZellInhalt(ddInhalt, ZelleNr) = .Formula

            ' Speichern, ob die Zelle eine Formel / Wert enthielt
            ZellInhalt(ddFormel, ZelleNr) = .HasFormula
        End With
    Next ZelleNr
End Sub

Dies war nur eine kleine Verbesserung des Codes, um in lesbarer zu machen. Wenn man auf so ein Array mehrfach im Code zugreifen muss, dann reduziert das sicher die Fehler beim Schreiben des Programms.

Reduktion auf eine Dimension

Bearbeiten

Die nächste Überarbeitung hat eine ganz andere Qualität: Das Array wird nun eindimensional. Die unterschiedlichen Daten werden jetzt mit einer Typdefinition (Private Type) zusammengefasst. Mit ein paar zusätzlichen Maßnahmen spart dies viel Speicherplatz, denn durch die Typdefinition wird die Information kompakt gespeichert:

  • Adresse wird nun als Range angelegt, da eine Objektreferenz nur 4 Bytes braucht. In den anderen Versionen wurde ein String mit der Adresse belegt, wo jedes Zeichen ein Byte braucht. Nachteil der Objektreferenz: Wird die Tabelle geschlossen, verliert die Objektreferenz die Verbindung zur Zelle.
  • Der Inhalt, also ein Wert oder eine Formel bleibt weiterhin ein Text
  • IstFormel ist vom Typ Bool, also nur noch ein Byte groß.

Dazu kann man mit der Array-Variablen Intellisense benutzen, denn Adresse, Inhalt und IstFormel werden automatisch angeboten, was Programmierfehler erheblich minimiert. Die Typdefinition steht wieder im Deklarationsteil des Moduls, also außerhalb der Prozedur.

' Typdefinition
Public Type InhaltsArt
    Adresse As Range
    Inhalt As String
    IstFormel As Boolean
End Type

Public Sub DimensionsDemo3()
    Dim ZellInhalt() As InhaltsArt, Markierung As Range
    Dim ZelleNr As Long
    
    ' Bereich verkleinern, nur den benutzten Bereich bearbeiten
    Set Markierung = Intersect(Selection.Cells, Selection.Parent.UsedRange).Cells
    
    ' Array auf die Größe des Bereiches setzen
    ReDim ZellInhalt(1 To Markierung.Count)
    
    For ZelleNr = 1 To Markierung.Count
        ' Adresse der Zelle speichern
        Set ZellInhalt(ZelleNr).Adresse = Markierung(ZelleNr)
        
        ' Inhalt der Zelle speichern
        ZellInhalt(ZelleNr).Inhalt = Markierung(ZelleNr).Formula

        ' Speichern, ob die Zelle eine Formel / Wert enthielt
        ZellInhalt(ZelleNr).IstFormel = Markierung(ZelleNr).HasFormula
    Next ZelleNr
End Sub

Man beachte, dass die Eigenschaft .Cells nun in die Anweisung Set Markierung = ... gewandert ist, was den Zugriff auf die Variable Markierung vereinfacht.!


Die letzte Variante soll besonders speicherplatzeffizient sein, da nur noch Zellen gespeichert werden, die tatsächlich gefüllt sind. Dazu wird jede Zelle geprüft, ob sie leer ist. Wenn sie voll ist, wird sie gespeichert und ein der Zähler LetzteBelegteZelle erhöht. Ganz zum Schluss wird das Array auf die Größe der tatsächlich belegten Zellen verkleinert.

' Typdefinition
Private Type InhaltsArt
    Adresse As Range
    Inhalt As String
    IstFormel As Boolean
End Type

Public Sub DimensionsDemo4()
    Dim ZellInhalt() As InhaltsArt, Markierung As Range
    Dim ZelleNr As Long, LetzteBelegteZelle As Long
    
    ' Bereich verkleinern, nur den benutzten Bereich bearbeiten
    Set Markierung = Intersect(Selection.Cells, Selection.Parent.UsedRange).Cells
    
    ' Array auf die Größe des Bereiches setzen
    ReDim ZellInhalt(1 To Markierung.Count)
    
    For ZelleNr = 1 To Markierung.Count
        If Not IsEmpty(Markierung(ZelleNr)) Then
            
            ' Zähler: Nur belegte Zellen zählen
            LetzteBelegteZelle = LetzteBelegteZelle + 1
            
            ' Adresse der Zelle speichern
            Set ZellInhalt(LetzteBelegteZelle).Adresse = Markierung(ZelleNr)
        
            ' Inhalt der Zelle speichern
            ZellInhalt(LetzteBelegteZelle).Inhalt = Markierung(ZelleNr).Formula
    
            ' Speichern, ob die Zelle eine Formel / Wert enthielt
            ZellInhalt(LetzteBelegteZelle).IstFormel = Markierung(ZelleNr).HasFormula
        End If
    Next ZelleNr
    
    ReDim Preserve ZellInhalt(1 To LetzteBelegteZelle)
End Sub

Beim Verkleinern ist das Preserve nach dem Redim wichtig, sonst werden die Inhalte des Arrays gelöscht!

Klassenmodule

Bearbeiten


Module in Objekten

Bearbeiten

Module sind Container für Code und für Variablen. Code ist jede Funktion, die einen oder mehrere Werte zurückgibt oder ein Makro, das keine Werte zurückliefert. Ein Modul ist also ein Container für VBA-Routinen.

Excel/VBA kennt Standard- und Klassenmodule. In Standardmodule wird Code zum allgemeinen Programmablauf hinterlegt, Klassenmodule verwalten Objekte mit ihren Eigenschaften, Methoden und Ereignissen.

In Excel gibt es eine Vielzahl von vordefinierten Klassen, um einige zu nennen:

WorkBook
In der Entwicklungsumgebung standardmäßig mit dem Objektnamen DieseArbeitsmappe bzw. ThisWorkbook benannt.

WorkSheet
In der Entwicklungsumgebung standardmäßig mit den jeweiligen Arbeitsblattnamen benannt.

Chart
In der Entwicklungsumgebung standardmäßig mit den jeweiligen Chart-Namen benannt.

UserForm
In der Entwicklungsumgebung standardmäßig mit dem jeweiligen UserForm-Namen benannt.

Die vorgenannten eingebauten Excel-Klassen können mit ihren Ereignissen in neue Klassen eingebunden werden. Sinnvoll ist dies beispielsweise, wenn eine Worksheet_Change-Ereignisprozedur allgemeingültig werden, sich also nicht nur auf die Arbeitsmappe beschränken soll, in der sich der Code befindet.

Allgemeingültiges Worksheet_Change-Ereignis

Bearbeiten

Hier wird eine dem WorkBook-Objekt übergeordnete Klasse, also das Application-Objekt als Ausgangspunkt benötigt. In der Entwicklungsumgebung wird über das Menü Einfügen ein neues Klassenmodul erstellt. Der Name des neuen Klassenmoduls kann mit dem Aufruf der Eigenschaften mit der F4-Taste geändert werden ( in diesem Fall 'clsApp' ).

In das Klassenmodul wird zum einen eine Public-Variable für das Ereignis des Application-Objekts und zum anderen der zugehörige Ereigniscode eingetragen:

Public WithEvents App As Application   

Private Sub App_SheetChange( _  
   ByVal Sh As Object, _   
   ByVal Target As Range)   
   MsgBox "Zelle " & Target.Address(False, False) & _ 
      " aus Blatt " & ActiveSheet.Name & _
      " aus Arbeitsmappe " & ActiveWorkbook.Name & _
      " wurde geändert!"
End Sub

In der Workbook_Open-Prozedur wird die neue App-Klasse deklariert und initialisiert:

Dim AppClass As New clsApp   

Private Sub Workbook_Open()   
   Set AppClass.App = Application 
End Sub

Eine Ereignisprozedur für mehrere CommandButtons

Bearbeiten

In das Klassenmodul 'clsButton' wird zum einen eine Public-Variable für das Ereignis des CommandButton-Objekts und zum anderen der zugehörige Ereigniscode eingetragen:

Public WithEvents Btn As CommandButton   

Private Sub Btn_Click()  
   MsgBox "Aufruf erfolgt von Schaltfläche " & Right(Btn.Caption, 1)
End Sub

Die Deklaration und Initialisierung der Btn-Klasse erfolgt in der Workbook_Open-Prozedur (das Workbook muss übrigens ein Worksheet 'Buttons' mit (mindestens) vier aus der Steuerelement-Toolbox eingefügten Befehlsschaltflächen beinhalten):

Dim CntBtn(1 To 4) As New clsButton    

Private Sub Workbook_Open()   
   Dim intCounter As Integer    
   For intCounter = 1 To 4  
      Set CntBtn(intCounter).Btn = ThisWorkbook.Worksheets("Buttons").OLEObjects(intCounter).Object  
   Next intCounter 
End Sub

Ein- und Auslesen einer Kundenliste

Bearbeiten

Zusätzlich zu diesen vordefinierten können neue, benutzerdefinierte Klassen geschaffen werden, mit denen es auf programmiertechnisch elegante Art möglich ist, eigene Typen zu bilden und z.B. mit Plausibilitätsprüfungsroutinen auf diese zuzugreifen.

In das Klassenmodul 'clsKunden' werden zum einen die Public-Variablen für Elemente des Kunden-Objekts und zum anderen eine Prüfroutine eingetragen:

Option Explicit 
Public strNA As String   
Public strNB As String   
Public strS As String   
Public strC As String   
Public strPLZ As String   

Property Let strP(strP As String)  
   If Not IsNumeric(strP) Then    
      MsgBox strP & " ist eine ungültige Postleitzahl"
      strPLZ = "?????"
   Else 
      strPLZ = strP
   End If  
End Property

Die Deklaration und die allgemeinen Codes werden in einem Standardmodul hinterlegt:

Dim NeuerKunde As New clsKunden   
Dim colKunden As New Collection   

Sub Einlesen() 
   Dim intCounter As Integer    
   Set colKunden = Nothing  
   For intCounter = 2 To 11  
      Set NeuerKunde = New clsKunden  
      With NeuerKunde 
         .strNA = Cells(intCounter, 1).Value
         .strNB = Cells(intCounter, 2).Value
         .strS = Cells(intCounter, 3).Value
         .strP = Cells(intCounter, 4).Value
         .strC = Cells(intCounter, 5).Value
      End With  
      colKunden.Add NeuerKunde
   Next intCounter 
End Sub  

Sub AdressenAusgeben() 
   Dim knd As clsKunden  
   For Each knd In colKunden   
      With knd 
         MsgBox .strNA & vbLf & .strNB & vbLf & .strS & _
              vbLf & .strPLZ & " " & .strC
      End With  
   Next 
End Sub

Ereignissteuerung einer Serie von Labels

Bearbeiten

Mit den nachfolgenden Prozeduren werden 256 Labels einer UserForm mit MouseMove, MouseClick- und anderen Ereignissen versehen.

In das Klassenmodul 'clsFrm' werden zum einen die Public-Variable für die Ereignisse des Label-Objekts und zum anderen die zugehörigen Ereigniscodes eingetragen:

Public WithEvents LabelGroup As MSForms.Label    

Private Sub LabelGroup_Click()  
   With frmChar.txtString  
      .Text = .Text & Me.LabelGroup.Caption
   End With  
End Sub  

Private Sub LabelGroup_DblClick( _  
   ByVal Cancel As MSForms.ReturnBoolean)    
   frmChar.txtString.Text = Me.LabelGroup.Caption 
End Sub  

Private Sub LabelGroup_MouseDown(ByVal Button As Integer, _       
   ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)     
   Me.LabelGroup.ForeColor = &H80000009 
   Me.LabelGroup.BackColor = &H80000012
End Sub  

Private Sub LabelGroup_MouseMove(ByVal Button As Integer, _      
   ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)     
   Dim strChar As String   
   Dim intChar As Integer    
   frmChar.lblChar.Caption = Me.LabelGroup.Caption
   strChar = Me.LabelGroup.Name
   intChar = CInt(Right(strChar, Len(strChar) - 5)) - 1 
   frmChar.lblShortCut.Caption = "Alt+" & intChar
   frmChar.lblZeichen.Caption = "=ZEICHEN(" & intChar & ")"
End Sub  

Private Sub LabelGroup_MouseUp(ByVal Button As Integer, _      
   ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)     
   Me.LabelGroup.ForeColor = &H80000012 
   Me.LabelGroup.BackColor = &H80000009
End Sub

Die Deklaration und Initialisierung der Labels-Klasse erfolgt in einem Standardmodul:

Dim Labels(1 To 256) As New clsFrm    

Sub ClsSymbolAufruf() 
   Dim intCounter As Integer    
   For intCounter = 1 To 256  
      Set Labels(intCounter).LabelGroup = frmChar.Controls("Label" & intCounter) 
   Next intCounter 
   frmChar.Show
End Sub

Eigenständige Klassenmodule

Bearbeiten

Während die Klassenmodule des vorherigen Abschnitts Teil eines anderen Objektes waren (Arbeitsmappe, Formular, Tabelle, Diagramm ...) sollen die folgenden Beispiele einige Anwendungen von Klassenmodulen geben, die in Standard- und anderen Klassenmodulen verwendbar sind. In der Entwicklungsumgebung (VBE) handelt es sich um ein Modul, welches mit "Einfügen -> Klassenmodul" erzeugt werden kann.

Klasse als intelligente Variable

Bearbeiten

Das folgende einfache Beispiel nutzt eine Klasse als Variable. Die eigentliche Aufgabe ist es, einen einfachen Mechanismus zu finden, mit dem ein Programm Winkel in einer Variablen zu speichern kann. Dabei sollen mehrere Variable unabhängig erzeugt und verwaltet werden. Ziel soll es sein, dass die Variable drei bekannte Winkelformate speichern, zurückgeben und konvertieren kann:

  • Grad oder Altgrad, Winkel am Vollkreis zwischen 0° … 360°
  • Radiant, Winkel am Vollkreis zwischen 0 … π
  • Neugrad oder Gon, Winkel am Vollkreis zwischen 0 gon … 400 gon

Nebenbei soll die Möglichkeit bestehen, den Wert des Winkels zu normalisieren, d.h. ein Winkel in Altgrad auf den Bereich von 0 … 360° zurückgeführt werden, so dass die Variable beispielsweise 540° in 180° oder -90° in 270° umwandelt und dies als normalisierten Wert zurückgibt.

Anwendung der Klasse als Variable

Bearbeiten

Die folgende Funktion zeigt den Einsatz der nachfolgend definierten Klasse. Zunächst wird eine (oder mehrere) Variable mit dem Objekttyp der Klasse (hier wurde clsWinkel gewählt) und dem schlüsselwort New dimensioniert.

Die Zuweisung eines Zahlenwertes zum Winkel erfolgt über eine der Methoden DEG, RAD oder GON, je nach dem, welches Winkelformat der Zahlenwert hat. Zurückrufen kann man den (umgerechneten) Wert ebenfalls über die Methoden DEG, RAD oder GON im jeweiligen Winkelformat. Über die Eigenschaft Normalisiert kann festgelegt werden, ob die Rückgabe normalisiert wird oder ob Winkel ihren ursprünglichen Zahlenwert behalten.

Public Sub WinkelTest()
    Dim Winkel1 As New clsWinkel, Winkel2 As New clsWinkel
    
    With Winkel1
        .Normalisieren = True
        .DEG = 540
    End With
    MsgBox "Winkel in Radiant, normalisiert: " & Winkel1.RAD

    Winkel1.RAD = WorksheetFunction.Pi / 2
    MsgBox "Winkel in Gon, normalisiert: " & Winkel1.GON

    Winkel2.GON = 500
    MsgBox "Winkel in Gon, nicht normalisiert: " & Winkel1.GON
End Sub

Programmcode der Klasse

Bearbeiten

Damit das vorherige Beispiel funktioniert, muss die folgende Klasse unter dem Namen clsWinkel abgespeichert werden.

Option Explicit

' Aufzählung für das Winkelmass
Private Enum WinkelEinheit
    wDeg = 0 ' Altgrad  0° ... 360°
    wRad = 1 ' Radiant  0  ... 2×Pi
    wGon = 2 ' Neugrad  0 ... 400 Gon
End Enum

' Interne Liste der Umrechnungsfaktoren
Private Faktor(wDeg To wGon) As Double

' Interne Speicherung des Wertes
Private WinkelWert  As Double

' Interne Speicherung der Einheit
Private WinkelMass  As WinkelEinheit

' Variable, um das Normalisieren einzuschalten.
' Dadurch wird Wert auf max. 360°/2×Pi/400 begrenzt
Public Normalisieren As Boolean

Private Sub Class_Initialize()
    Faktor(wDeg) = 180
    Faktor(wRad) = 3.14159265358979
    Faktor(wGon) = 200
End Sub

' Als Altgrad speichern
Public Property Let DEG(Wert As Double)
    WinkelWert = Wert
    WinkelMass = wDeg
End Property

' Wert in Altgrad zurückrufen
Public Property Get DEG() As Double
    If Normalisieren Then NormiereWinkel
    DEG = WinkelWert * Faktor(wDeg) / Faktor(WinkelMass)
End Property

' Als Radiant speichern
Public Property Let RAD(Wert As Double)
    WinkelWert = Wert
    WinkelMass = wRad
End Property

' Wert in Radiant zurückrufen
Public Property Get RAD() As Double
    If Normalisieren Then NormiereWinkel
    RAD = WinkelWert * Faktor(wRad) / Faktor(WinkelMass)
End Property

' Als Neugrad (Gon) speichern
Public Property Let GON(Wert As Double)
    WinkelWert = Wert
    WinkelMass = wGon
End Property

' Wert in Neugrad (Gon) zurückrufen
Public Property Get GON() As Double
    If Normalisieren Then NormiereWinkel
    GON = WinkelWert * Faktor(wGon) / Faktor(WinkelMass)
End Property

' Winkel in den Bereich 0...360° verschieben
Private Sub NormiereWinkel()
    If Abs(WinkelWert) > 2 * Faktor(WinkelMass) Then
        WinkelWert = Sgn(WinkelWert) * (Abs(WinkelWert) Mod (2 * Faktor(WinkelMass)))
    End If
    If WinkelWert < 0 Then WinkelWert = WinkelWert + 2 * Faktor(WinkelMass)
End Sub

Erklärung zu den einzelnen Funktionen:

  • Die Variable Normalisieren ist öffentlich sichtbar. Sie wird beim Erzeugen auf FALSE gesetzt, so dass die Normalisierung nicht durchgeführt wird.
  • Da die drei Methoden DEG, RAD und GON jeweils ein unterschiedliches Verhalten zeigen sollen, je nach dem, ob man einen Wert in die Variable speichert oder aus ihr zurückruft, müssen Property Let den Code für das Speichern in die Klasse (die wir als Variable benutzen) enthalten und Property Get Prozeduren für den Rückruf der Variablen aus der Klasse.
  • Da in VBA Arrays nicht als Konstanten deklariert werden können, muss die Class_Initialize-Prozedur ein Array belegen.


Code-Optimierung

Bearbeiten


Die folgende Grundsätze verhelfen zu einer optimalen Ablaufgeschwindigkeit Ihres VBA-Programms:

Konstanten

Bearbeiten

Deklarieren Sie, wo immer möglich, Konstanten statt Variablen.

Objektindex

Bearbeiten

Wenn es die Klarheit des Codes nicht stört, verwenden Sie bei Objekt-Schleifen den Index des Objektes, nicht den Namen.

Worksheets(intCounter)

ist schneller als

Worksheets("Tabelle1")

Allerdings gehen For-Each-Schleifen vor, denn

For Each wksData In Worksheets
wksData
Next

ist schneller als

Worksheets(intCounter)

Grundsätzlich sollten im Code keine Adressen stehen, die sich ändern könnten. Eine bessere Lösung ist die Nutzung von Konstanten,

    
    Const TabName = "Tabelle1"
    Const TabIndex = 1

    Worksheets(TabName)
    Worksheets(TabIndex)

wobei die Konstanten zur besseren Übersicht am Anfang stehen.

Direkte Objektzuweisungen

Bearbeiten

Verwenden Sie nach Möglichkeit keine allgemeinen Objektzuweisungen. Das folgende Beispiel zeigt immer genauere Verweise:

Dim wksData
Dim wksData As Object
Dim wksData As Worksheet

Hinweise zur dritten Art der Deklaration:

  • Sie ist nicht immer möglich, denn sie setzt voraus, dass die Bibliothek über die Verweise (References) eingebunden ist.
  • Sie hat den Vorteil, dass IntelliSense nach Eingabe eines Punktes Vorschläge machen kann, welche Eigenschaften und Methoden zu dem Objekt passen.
Wenn die Objekte einer anderen Anwendung entstammen (z.B. Word oder Access), muss zunächst der Verweis auf die Objektbibliothek eingefügt werden, damit Intellisense funktioniert.
  • Fehler im Code werden leichter gefunden, weil bei Variante 1 der Variablen wksData jeder Datentyp zugewiesen werden kann und in Variante 2 immer noch jeder Objektdatentyp.

Selektieren

Bearbeiten

Wählen Sie keine Arbeitsmappen, Blätter, Bereiche oder andere Objekte aus, um beispielsweise einen Wert zu schreiben:

Workbooks("Test.xls").Activate
Worksheets("Tabelle1").Select
Range("A1").Select
ActiveCell.Value = 12

Referenzieren Sie stattdessen exakt:

Workbooks("Test.xls").Worksheets("Tabelle1").Range("A1").Value = 12

Der Umweg über die Selektion bedeutet auch, dass das Blatt sichtbar gemacht wird und der Monitor nach Ablauf des Makros das zuletzt selektierte Objekt zeigt.

Keine eckigen Klammern

Bearbeiten

Verwenden Sie für Zellbereiche nicht die Schreibweise in eckigen Klammern:

[b3] = [d4]

Schreiben Sie stattdessen (Ausführungszeit ca. 66% von vorigem):

Range("B3").Value = Range("D4").Value

Noch etwas schneller (Ausführungszeit ca. 90% von vorigem bzw. 60% von ersterem):

Cells(3,2).Value = Cells(4,4).Value   ' Cells(ZeilenNr, SpaltenNr)

Hinweis: Beachten Sie, dass bei Angabe des Zellbezugs als String die Range-Eigenschaft verwendet werden muss, wohingegen bei der Angabe als Zahlen die Cells-Eigenschaft verwendet werden muss.

Direkte Referenzierung

Bearbeiten

Referenzieren Sie - wenn der Programmablauf es nicht erforderlich macht - nicht hierarchieweise:

Set wkbData = Workbooks("Test.xls")
Set wksData = wkbData.Worksheets("Tabelle1")
Set rngData = wksData.Range("A1:F16")

Referenzieren Sie stattdessen direkt das Zielobjekt:

Set rngData = Workbooks("Test.xls").Worksheets("Tabelle1").Range("A1:F16")

Dimensionierung

Bearbeiten

Dimensionieren Sie die Variablen nicht allgemeiner als dies erforderlich ist:

Dim intCounter As Integer
ist schneller als: 
Dim varCounter as Variant

Hinweise:

  • Wenn eigentlich der Datentyp Byte ausreichen sollte, kann eine Subtraktion manchmal einen Unterlauf verursachen. Die Gefahr besteht vor allem bei FOR-Schleifen mit einem negativen Argument für STEP. In diesem Falle bei INTEGER bleiben.
  • In bestimmten Fällen kann man den Datentyp Variant nicht vermeiden, beispielsweise hier:
    • Der Rückgabewert einer Funktion soll bei Fehlern auch einen Fehlerwert der Funktion CVErr() ausgeben
    • VBA hat keinen eigenen Datentyp für lange Dezimalzahlen vom Typ Dec (Umwandlung mit CDec())
    • Bei optionalen Argumenten (mit Option MyVar einer Sub/Function kann mit IsMissing() nur auf ausgelassene Argumente geprüft werden, wenn der Datentyp Variant ist. Andernfalls erhält man immer die default-Belegung des Datentyps von MyVar, wenn das Argument ausgelassen wird
    • Wenn eine Variable ein Array aufnehmen soll, muss sie vom Typ Variant sein

Tipp: Noch etwas schneller als der Integer ist der Datentyp Long! Das liegt vermutlich daran, dass Integer 16-bittig ist während Long 32-bittig ist und alle neueren Prozessoren für 32-Bit optimiert sind.

With-Rahmen

Bearbeiten

Verwenden Sie With-Rahmen. Langsam ist:

Worksheets("Tabelle1").Range("A1:A16").Font.Bold = True
Worksheets("Tabelle1").Range("A1:A16").Font.Size = 12
Worksheets("Tabelle1").Range("A1:A16").Font.Name = "Arial"
Worksheets("Tabelle1").Range("A1:A16").Value = "Hallo!"

Schneller ist:

With Worksheets("Tabelle1").Range("A1:A16")
    With .Font
        .Bold = True
        .Size = 12
        .Name = "Arial"
    End With
    .Value = "Hallo!"
End With

Der Vorteil ist außerdem, dass die Ziele (Tabelle1 und A1:A16) nur einmal im Code stehen, was die Gefahr von Tippfehlern verringert.

Excel-Funktionen

Bearbeiten

Ziehen Sie Excel-Funktionen VBA-Routinen vor. Langsam ist:

For intCounter = 1 To 20
    dblSum = dblSum + Cells(intCounter, 1).Value
Next intCounter

Schneller ist:

dblSum = WorksheetFunction.Sum(Range("A1:A20"))

Wenn Sie große, zusammenhängende Zellbereiche berechnen müssen, setzen Sie zur eigentlichen Berechnung Excel-Formeln ein. Die Formeln können Sie danach in absolute Werte umwandeln:

Sub Berechnen()
    Dim intRow As Integer
    intRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("C1").Formula = "=A1+B1/Pi()"
    Range("C1:C" & intRow).FillDown
    Columns("C").Copy
    Columns("C").PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

Dasselbe Ergebnis hat folgende Prozedur, die auch With-Klammern verwendet und bei der Ersetzung der Formeln durch Werte ohne Copy/PasteSpecial auskommt:

Sub Berechnen2()
    Dim lngRow As Long
    lngRow = Cells(Rows.Count, 1).End(xlUp).Row
    With Range("C1:C" & lngRow)
      .Formula = "=A1+B1/Pi()" ' trägt die Formeln ein
      .Formula = .Value        ' ersetzt die Formeln durch Werte; .Value = .Value geht auch
    End With
    Range("A1").Select ' nur, wenn das nötig/erwünscht ist
End Sub

Tipp: Wenn Sie auf eine große Anzahl Zellen zugreifen müssen, dann ist es am schnellsten, wenn Sie die Werte mit einem Befehl in ein Array kopieren und dann aus dem Array lesen:

Function Berechne3()
    Dim Matrix As Variant   ' Array mit Inhalten der Tabelle
    Dim Summe As Long       ' Summe, Ergebnis
    Dim ZeNr As Long        ' Zeilenindex
    Dim SpNr As Long        ' Spaltenindex
    
    ' Übernahme des Tabellenbereichs in das Array
    Matrix = Range("A1:H800").Value
    
    For SpNr = 1 To 8  ' 1=A...8=H
       For ZeNr = 1 To 800
           Summe = Summe + Matrix(ZeNr, SpNr)
       Next ZeNr
    Next SpNr
    
    ' Ausgabe des Ergebnisses / Rückgabewert
    Berechne3 = Summe
End Function

Das Beispiel wurde der Einfachheit halber gewählt. Wie oben bereits erwähnt, würde man eine reine Summenberechnung mit einer Tabellenfunktion in VBA abbilden.

Array-Formeln

Bearbeiten

Setzen Sie temporäre Excel-Array-Formeln zur Matrixberechnung ein. Wenn Sie in VBA zwei Zellbereiche auf Übereinstimmung überprüfen wollen, müssen Sie einzelne Zellvergleiche vornehmen. Mit Einsatz einer Excel-Array-Formel sind Sie schneller. Im nachfolgenden Code werden zwei große Zellbereiche auf Übereinstimmung überprüft. Über VBA müsste man jede einzelne Zelle des einen mit der des anderen Bereiches vergleichen. Die Excel-Array-Formel liefert das Ergebnis unmittelbar nach dem Aufruf:

Function MatrixVergleich(strA As String, strB As String) As Boolean
    Range("IV1").FormulaArray = "=SUM((" & strA & "=" & strB & ")*1)"
    If Range("IV1").Value - Range(strA).Cells.Count = 0 Then
        MatrixVergleich = True
    End If
    Range("IV1").ClearContents
End Function

Sub Aufruf()
    MsgBox MatrixVergleich("C1:D15662", "E1:F15662")
End Sub

Zellbereiche schnell bearbeiten

Bearbeiten

Wenn eine Funktion einen Zellbereich abarbeiten soll, so kann dies sehr lange dauern, wenn der Bereich unnötig groß ist.

Beispiel: Der Benutzer möchte mit einer VBA-Funktion die Zellen A1:C300 bearbeiten. Das könnte so gehen:

  1. Der Benutzer markiert den Bereich A1:C300
  2. Der Benutzer startet ein Makro, wie das folgende AlleZellenBearbeiten():
Public Sub AlleZellenBearbeiten()
    Dim Zelle As Range
    On Error GoTo WeiterNächsteZelle

    For Each Zelle In Selection.Cells
        ' Jede Zelle einzeln bearbeiten
        Zelle.Value = ...
        
WeiterNächsteZelle: ' Sprung hierher bedeutet: Eine Zelle wegen Fehler nicht bearbeitet
    Next Zelle
End Sub

Oft ist es für den Benutzer einfacher, die Spalten A:C zu markieren, statt bis zum Ende des Bereiches zu scrollen und alles bis zur Zelle C300 zu markieren. Doch dadurch wird die Funktion sehr lange brauchen, da insbesondere ab Office 2007 3 Millionen Zellen markiert wurden. Im Makro kann man hier die Bearbeitung auf den benutzten Bereich einschränken. Dazu wird mit Intersect die Schnittmenge aus Markierung (Selection) und benutztem Bereich (UsedRange) als Bearbeitungsbereich festgelegt. Dabei ist der von Intersect zurückgegebene Bereich der jeweils kleinere Bereich:

Public Sub AlleZellenBearbeiten()
    Dim Zelle As Range
    On Error GoTo WeiterNächsteZelle
    For Each Zelle In Intersect(Selection, UsedRange).Cells
        ' Jede Zelle einzeln bearbeiten
        Zelle.Value = ...

WeiterNächsteZelle: ' Sprung hierher bedeutet: Eine Zelle wegen Fehler nicht bearbeitet
    Next Zelle
End Sub

Eine weitere Möglichkeit, der zu bearbeitenden Bereich einzuschränken und Abbrüche wegen Fehlern zu vermeiden, besteht darin, die Auswahl des Benutzers noch einmal auf den Zelltyp mit der Methode SpecialCells() einzuschränken. Wenn nur Werte, aber keine Formeln geändert werden sollen, schränkt man den Bereich mit SpecialCells(xlCellTypeConstants) ein:

Public Sub AlleZellenBearbeiten()
    Dim Zelle As Range, Bereich As Range
    
    On Error GoTo NichtsGefunden
    ' Wenn SpecialCells einen Fehler liefert, gibt es nichts zu bearbeiten
    Set Bereich = Selection.Cells.SpecialCells(xlCellTypeConstants)
    
    On Error GoTo WeiterNächsteZelle
    For Each Zelle In Bereich
        ' Jede Zelle einzeln bearbeiten
        Zelle.Value = ...

WeiterNächsteZelle: ' Sprung hierher bedeutet: Eine Zelle wegen Fehler nicht bearbeitet
    Next Zelle

NichtsGefunden: ' Sprung hierher bedeutet: Gar keine Aktion ausgeführt
End Sub

Durch SpecialCells(xlCellTypeConstants, xlTextValues + xlNumbers) werden nur noch Zahlen und Texte bearbeitet, Zellen mit logischen Werten (WAHR, FALSCH) oder Fehlerwerten bleiben außen vor.

Vorsicht: Wenn SpecialCells() keine Zellen findet, führt dies nicht etwa zu einem leeren Objekt, sondern zu einem Fehler, der nur mit On Error ... abgefangen werden kann.

Neuberechnung der Zellinhalte

Bearbeiten

Excel unterscheidet zwischen drei Berechnungsmodi: [1]

  • Automatisch
  • Automatisch außer bei Datentabellen
  • Manuell

Wollen Sie beispielsweise eine große Tabelle mit Ergebnissen aus Ihrem VBA-Code befüllen, so wird Excel im automatischen Modus nach jedem Eintrag das gesamte Dokument neu berechnen. Nutzen Sie daher folgenden Code, um die Neuberechnung aller Inhalte nur einmal am Ende auszuführen:

Sub TabelleBefuellen()
      'lokale Variablen deklarieren
      '...
   
   'Berechnungsmodus in manuell ändern
    Application.Calculation = xlCalculationManual
      
      'Ihr VBA Code: Tabelle befüllen
      'cells(x,y)= ...
      
   'Berechnungsmodus in automatisch ändern
   Application.Calculation = xlCalculationAutomatic
   
End Sub

Im manuellen Modus hingegen müssen Sie die Neuberechnung der Zellen manuell ausführen:

ActiveSheet.EnableCalculation = True
ActiveSheet.Calculate

Bemerkung: Die Neuberechnung des gesamten Dokuments nach einem Zelleintrag kann >1 Sekunde dauern, was bei Tabellen mit 1000 Zeilen und 10 Spalten über 10.000 Sekunden, also deutlich über 2 Stunden dauert!

Einzelnachweise

Bearbeiten
  1. [1] MSDN VBA Excel-Neuberechnung

Menü- und Symbolleisten

Bearbeiten


Grundsätzliches

Bearbeiten

Menü- und Symbolleisten sind sowohl manuell wie auch über VBA zu erstellen, zu verändern und zu löschen.

Seit der Excel-Version 8.0 (Office 97) handelt es sich bei den Menü- und Symbolleisten um das Objektmodell der Commandbars mit den zugehörigen Control-Elementen CommandBarButton, CommandBarPopUp und CommandBarComboBox unter dem Oberbegriff CommandBarControl.

Grundsätzlich empfiehlt es sich, zu einer Arbeitsmappe gehörende CommandBars oder CommandBarControls beim Öffnen der Arbeitsmappe über das Workbook_Open-Ereignis zu erstellen und über das Workbook_BeforeClose-Ereignis zu löschen. Nur so ist gewährleistet, dass der Anwender nicht durch Auswirkungen von CommandBar-Programmierungen oder -Anbindungen belästigt wird.

Der Commandbars-Auflistung fügt man mit der Add-Methode eine neue Leiste hinzu. Erfolgt die Erstellung der neuen CommandBar in einem Klassenmodul, ist die Syntax Application.CommandBars.Add... zwingend erforderlich, erfolgt die Erstellung in einem Standardmodul, reicht ein CommandBars.Add.... Um später mögliche Kollisionen mit anderen Office-Anwendungen zu vermeiden, wird allerdings auch hier die Application-Nennung empfohlen.

Die Add-Methode kann mit bis zu 9 Parameter aufgerufen werden:

    • Name
      Der Name der Symbolleiste, zwingend erforderlich
    • Position
      optional, folgende Konstanten sind möglich:
      • msoBarLeft (am linken Bildschirmrand)
      • msoBarRight (am rechten Bildschirmrand)
      • msoBarTop (wird an die bestehenden Symbolleisten angegliedert)
      • msoBarBottom (am unteren Bildschirmrand, über der Statusleiste)
      • msoBarFloating (nicht verankerte Symbolleiste, die Position kann festgelegt werden)
      • msoBarPopUp (Kontext-Symbolleiste, mit der rechten Maustaste im Tabellenblatt aufrufbar)
    • MenuBar
      optional, legt fest, ob es sich um eine Menü- oder eine Symbolleiste handelt (TRUE = Menüleiste, FALSE = Symbolleiste, Voreinstellung ist FALSE).
    • Temporary
      optional, legt fest, ob die Menü- oder Symbolleiste mit Microsoft Excel geschlossen werden soll (TRUE = temporär, FALSE = bestehenbleibend, Voreinstellung ist FALSE). Wird also TRUE festgelegt, wird die CommandBar gelöscht, wenn Excel geschlossen wird und taucht auch in der CommandBar-Auflistung nicht mehr auf.

    Beispiele für das VBA-Handling von CommandBars

    Bearbeiten

    Menüleiste ein-/ausblenden

    Bearbeiten
    • Prozedur: CmdBarEinAus
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Arbeitsblattmenüleiste aus- und einblenden.
    • Ablaufbeschreibung:
      • Rahmen mit dem CommandBar-Objekt bilden
      • Wenn eingeschaltet ausschalten, sonst einschalten
    • Code:
    Sub CmdBarEinAus()
       With Application.CommandBars("Worksheet Menu Bar")
          .Enabled = Not .Enabled
       End With
    End Sub
    

    Neue Menüleiste erstellen und einblenden

    Bearbeiten
    • Prozedur: NewMenueBar
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Es wird eine neue Menüleiste erstellt und eingeblendet, wobei die Arbeitsblattmenüleiste ausgeblendet wird.
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Prozedur zum Löschen der evtl. bereits bestehenden Menüleiste aufrufen
      • Menüleiste erstellen
      • 1. Menü erstellen
      • Schleife über 12 Monate bilden
      • Monatsschaltfläche erstellen
      • Rahmen um das Schaltflächenobjekt erstellen
      • Aufschriftung festlegen
      • Der Schaltfläche keine Prozedur zuweisen
      • Den Aufschrifttyp festlegen
      • 2. Menü erstellen
      • Schleife über 12 Monate bilden
      • Monatsschaltfläche erstellen
      • Rahmen um das Schaltflächenobjekt erstellen
      • Aufschriftung festlegen
      • Der Schaltfläche keine Prozedur zuweisen
      • Den Aufschrifttyp festlegen
      • Arbeitsblattmenüleiste ausblenden
      • Neue Menüleiste einblenden
    • Code:
    Sub NewMenueBar()
       Dim oCmdBar As CommandBar
       Dim oPopUp As CommandBarPopup
       Dim oCmdBtn As CommandBarButton
       Dim datDay As Date
       Dim iMonths As Integer
       Call DeleteNewMenueBar
       Set oCmdBar = Application.CommandBars.Add( _
          Name:="MyNewCommandBar", _
          Position:=msoBarTop, _
          MenuBar:=True, _
          temporary:=True)
       Set oPopUp = oCmdBar.Controls.Add(msoControlPopup)
       oPopUp.Caption = "Prüfung"
       For iMonths = 1 To 12
          Set oCmdBtn = oPopUp.Controls.Add
          With oCmdBtn
             .Caption = Format(DateSerial(1, iMonths, 1), "mmmm") & " Druck"
             .OnAction = ""
             .Style = msoButtonCaption
          End With
       Next iMonths
       Set oPopUp = oCmdBar.Controls.Add(msoControlPopup)
       oPopUp.Caption = "Monatsbericht"
       For iMonths = 1 To 12
          Set oCmdBtn = oPopUp.Controls.Add
          With oCmdBtn
             .Caption = Format(DateSerial(1, iMonths, 1), "mmmm") & " Druck"
             .OnAction = ""
             .Style = msoButtonCaption
          End With
       Next iMonths
       Application.CommandBars("Worksheet Menu Bar").Enabled = False
       oCmdBar.Visible = True
    End Sub
    
    • Prozedur: DeleteNewMenueBar
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Evtl. bestehende Menüleiste löschen
    • Ablaufbeschreibung:
      • Fehlerroutine für den Fall starten, dass die Menüleiste nicht existiert
      • Benutzerdefinierte Menüleiste löschen
      • Arbeitsblattmenüleiste einblenden
    • Code:
    Private Sub DeleteNewMenueBar()
       On Error GoTo ERRORHANDLER
       Application.CommandBars("MyNewCommandBar").Delete
       Application.CommandBars("Worksheet Menu Bar").Enabled = True 
       Exit Sub
    ERRORHANDLER:
    End Sub
    

    Alle Menüleisten ein-/ausblenden

    Bearbeiten
    • Prozedur: AllesAusEinBlenden
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Alle Menü- und Symbolleisten aus- und einblenden.
    • Ablaufbeschreibung:
      • Objektvariable für CommandBar erstellen
      • Rahmen um das CommandBar-Objekt erstellen
      • Wenn die Arbeitsblattmenüleiste eingeblendet ist...
      • Arbeitsblattmenüleiste ausblenden
      • Auf Vollbildschirm schalten
      • Eine Schleife über die CommandBars bilden
      • Wenn es sich bei der aktuellen CommandBar nicht um die Arbeitsblattmenüleiste handelt...
      • Wenn die aktuelle CommandBar sichtbar ist...
      • Die aktuelle Commandbar ausblenden
      • Aktive Arbeitsmappe schützen, wobei der Windows-Parameter auf True gesetzt wird (hierdurch werden die Anwendungs- und Arbeitsmappen-Schließkreuze ausgeblendet)
      • Wenn die Arbeitsblattmenüleiste nicht sichtbar ist...
      • Arbeitsmappenschutz aufheben
      • Arbeitsblattmenüleiste anzeigen
      • Vollbildmodus ausschalten
    • Code:
    Sub AllesAusEinBlenden()
       Dim oBar As CommandBar
       With CommandBars("Worksheet Menu Bar")
          If .Enabled Then
             .Enabled = False
             Application.DisplayFullScreen = True
             For Each oBar In Application.CommandBars
                If oBar.Name <> "Worksheet Menu Bar" Then
                   If oBar.Visible Then
                      oBar.Visible = False
                   End If
                End If
             Next oBar
             ActiveWorkbook.Protect Windows:=True
          Else
             ActiveWorkbook.Unprotect
             .Enabled = True
             Application.DisplayFullScreen = False
          End If
       End With
    End Sub
    

    Jahreskalender als Symbolleiste erstellen bzw. löschen

    Bearbeiten
    • Prozedur: NewCalendar
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Jahreskalender als Symbolleiste anlegen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Fehlerroutine einschalten
      • Jahreskalender-Symbolleiste löschen
      • Prozedur beenden
      • Wenn keine Jahreskalender-Symbolleiste vorhanden war...
      • Neue Symbolleiste erstellen
      • Schleife über 12 Monate bilden
      • Menü für jeden Monat anlegen
      • Menüaufschrift festlegen
      • Wenn der Monatszähler durch 4 teilbar ist, eine neue Gruppe beginnen
      • Die Tagesanzahl des jeweiligen Monats ermitteln
      • Eine Schleife über die Tage des jeweiligen Monats bilden
      • Das jeweilig aktuelle Datum ermitteln
      • Tagesschaltfläche erstellen
      • Aufschrift der Tagesschaltfläche festlegen
      • Aufschriftart der Tagesschaltfläche festlegen
      • Aufzurufende Prozedur festlegen
      • Wenn es sich um einen Montag handelt, eine neue Gruppe beginnen
      • Neue Symbolleiste anzeigen
    • Code:
    Sub NewCalendar()
       Dim oCmdBar As CommandBar
       Dim oPopUp As CommandBarPopup
       Dim oCmdBtn As CommandBarButton
       Dim datDay As Date
       Dim iMonths As Integer, iDays As Integer, iCount As Integer
       On Error GoTo ERRORHANDLER
       Application.CommandBars(CStr(Year(Date))).Delete
       Exit Sub
    ERRORHANDLER:
       Set oCmdBar = Application.CommandBars.Add( _
          CStr(Year(Date)), msoBarTop, False, True)
       For iMonths = 1 To 12
          Set oPopUp = oCmdBar.Controls.Add(msoControlPopup)
          With oPopUp
             .Caption = Format(DateSerial(1, iMonths, 1), "mmmm")
             If iMonths Mod 3 = 1 And iMonths <> 1 Then .BeginGroup = True
             iCount = Day(DateSerial(Year(Date), iMonths + 1, 0))
             For iDays = 1 To iCount
                datDay = DateSerial(Year(Date), iMonths, iDays)
                Set oCmdBtn = oPopUp.Controls.Add
                With oCmdBtn
                   .Caption = Day(datDay) & " - " & Format(datDay, "dddd")
                   .Style = msoButtonCaption
                   .OnAction = "GetDate"
                   If Weekday(datDay, vbUseSystemDayOfWeek) = 1 And iDays <> 1 Then .BeginGroup = True
                End With
             Next iDays
          End With
       Next iMonths
       oCmdBar.Visible = True
    End Sub
    


    • Prozedur: GetDate
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Das aufgerufene Tagesdatum melden
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Aktuelles Jahr ermitteln
      • Monat ermitteln, aus dem der Aufruf erfolgte
      • Tag ermitteln, der ausgewählt wurde
      • Ausgewähltes Datum melden
    • Code:
    Sub GetDate()
       Dim iYear As Integer, iMonth As Integer, iDay As Integer
       Dim iGroupM As Integer, iGroupD As Integer
       iYear = Year(Date)
       iMonth = WorksheetFunction.RoundUp(Application.Caller(2) - _
          (Application.Caller(2) / 4), 0)
       iDay = Application.Caller(1) - GetGroups(iMonth, Application.Caller(1))
       MsgBox Format(DateSerial(iYear, iMonth, iDay), "dddd - dd. mmmm yyyy")
    End Sub
    
    • Prozedur: GetGroups
    • Art: Function
    • Modul: Standardmodul
    • Zweck: Gruppe auslesen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Zählvariable initialisieren
      • Eine Schleife über alle Monate der Jahreskalender-Symbolleiste bilden
      • Solange die Zählvariable kleiner/gleich die Anzahl der Controls...
      • Wenn eine neue Gruppe beginnt...
      • Gruppenzähler um 1 hochzählen
      • Wenn die Zählvariable gleich dem übergebenen Tag minus dem Gruppenzähler, dann Schleife beenden
      • Zählvariable um 1 hochzählen
      • Gruppenzähler als Funktionswert übergeben
    • Code:
    Private Function GetGroups(iActMonth As Integer, iActDay As Integer)
       Dim iGroups As Integer, iCounter As Integer
       iCounter = 1
       With Application.CommandBars(CStr(Year(Date))).Controls(iActMonth)
          Do While iCounter <= .Controls.Count
             If .Controls(iCounter).BeginGroup = True Then
                iGroups = iGroups + 1
             End If
             If iCounter = iActDay - iGroups Then Exit Do
             iCounter = iCounter + 1
          Loop
          GetGroups = iGroups
       End With
    End Function
    

    Alle Menü- und Symbolleisten auflisten

    Bearbeiten
    • Prozedur: ListAllCommandbars
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Alle Symbolleisten mit dem englischen und dem Landesnamen mit der Angabe, ob sichtbar oder nicht, auflisten
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Bildschirmaktualisierung ausschalten
      • Neue Arbeitsmappe anlegen
      • Kopfzeile schreiben
      • Kopfzeile formatieren
      • Zeilenzähler initialisieren
      • Eine Schleife über alle - eingebauten und benutzerdefinierten - CommandBars bilden
      • Den englischen Namen eintragen
      • Den Landesnamen eintragen
      • Den Sichtbarkeitsstatus eintragen
      • Spaltenbreiten automatisch anpassen
      • Nicht genutzte Spalten ausblenden
      • Nicht genutzte Zeilen ausblenden
      • Bildschirmaktualisierung einschalten
      • Speichernstatus der Arbeitsmappe auf WAHR setzen (um beim Schließen eine Speichern-Rückfrage zu übergehen)
    • Code:
    Sub ListAllCommandbars()
       Dim oBar As CommandBar
       Dim iRow As Integer
       Application.ScreenUpdating = False
       Workbooks.Add 1
       Cells(1, 1) = "Name"
       Cells(1, 2) = "Lokaler Name"
       Cells(1, 3) = "Sichtbar"
       With Range("A1:C1")
          .Font.Bold = True
          .Font.ColorIndex = 2
          .Interior.ColorIndex = 1
       End With
       iRow = 1
       For Each oBar In Application.CommandBars
          iRow = iRow + 1
          Cells(iRow, 1) = oBar.Name
          Cells(iRow, 2) = oBar.NameLocal
          Cells(iRow, 3) = oBar.Visible
        Next oBar
        Columns("A:C").AutoFit
        Columns("D:IV").Hidden = True
        Rows(iRow + 1 & ":" & Rows.Count).Hidden = True
        Application.ScreenUpdating = True
        ActiveWorkbook.Saved = True
    End Sub
    

    Jahreskalender bei Blattwechsel anlegen bzw. löschen

    Bearbeiten
    • Prozedur: Worksheet_Activate
    • Art: Ereignis
    • Modul: Klassenmodul des Arbeitsblattes Dummy
    • Zweck: Jahreskalender-Symbolleiste erstellen
    • Ablaufbeschreibung:
      • Aufruf der Prozedur zur Erstellung bzw. dem Löschen des Kalenders
    • Code:
    Private Sub Worksheet_Activate()
       Call NewCalendar
    End Sub
    
    • Prozedur: Worksheet_Deactivate
    • Art: Ereignis
    • Modul: Klassenmodul des Arbeitsblattes Dummy
    • Zweck: Jahreskalender-Symbolleiste erstellen
    • Ablaufbeschreibung:
      • Aufruf der Prozedur zur Erstellung bzw. dem Löschen des Kalenders
    • Code:
    Private Sub Worksheet_Deactivate()
       Call NewCalendar
    End Sub
    

    Dateinamen der *.xlb-Datei ermitteln

    Bearbeiten

    Die Informationen über die CommandBars werden in einer .xlb-Datei mit je nach Excel-Version wechselndem Namen im Pfad der Anwenderbibliotheken im Excel-Verzeichnis abgelegt. Die nachfolgenden Routinen ermitteln den Namen und das Änderungs-Datum dieser Datei. Der Code ist nur ab XL9 (Office 2000) lauffähig, da die Application.UserLibraryPath- Eigenschaft bei der Vorgängerversion noch nicht implementiert war. Der folgende Code nutzt das Scripting.FileSystemObject aus der Scripting-Klasse und setzt deshalb einen Verweis auf die "Microsoft Scripting Runtime"-Library voraus. Der Verweis kann im Makroeditor unter Extras > Verweise gesetzt werden. Ohne diesen Verweis compiliert das Programm mit einem Fehler.

    • Prozedur: GetXLBName
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Name der XLB-Datei melden
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Funktion zur Ermittlung des Dateinamens aufrufen
      • Wenn ein Leerstring zurückgegeben wurde...
      • Negativmeldung
      • Sonst...
      • Meldung des Dateinamens
    • Code:
    Sub GetXLBName()
       Dim sFile As String
       sFile = FindFile(0)
       If sFile = "" Then
          MsgBox "Die *.xlb-Datei wurde nicht gefunden!"
       Else
          MsgBox "Name der *.xlb-Datei: " & vbLf & sFile
       End If
    End Sub
    
    • Prozedur: FindFile
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Name und Änderungsdatum der XLB-Datei ermitteln
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Excel-Version ermitteln
      • Wenn es sich um die Version 8.0 handelt...
      • Negativmeldung und Prozedurende
      • Ein Sripting.FileSystemObject erstellen
      • Den Ordner oberhalb des Anwenderbibliothekspfads ermitteln und um den Begriff \Excel erweitern
      • Eine Schleife über alle Dateien des ermittelten Ordners bilden
      • Wenn die Datei die Suffix .xlb beinhaltet...
      • Wenn das Änderungsdatum nach dem zuletzt ermittelten Änderungsdatum liegt...
      • Änderungsdatum der aktuellen Datei in eine Datums-Variable einlesen
      • Dateinamen in String-Variable einlesen
      • Dateiname und Änderungsdatum in eine Variant-Variable einlesen
      • Die Variant-Variable an die Funktion übergeben
    • Code:

    Private Function FindFile() As Variant
       Dim FSO As Scripting.FileSystemObject
       Dim oFile As Scripting.File
       Dim oFolder As Scripting.Folder
       Dim arrFile As Variant
       Dim datFile As Date
       Dim sFile As String, sVersion As String
       sVersion = Left(Application.Version, 1)
       If sVersion = "8" Then
          Beep
          MsgBox "Nur ab Version 9.0 möglich!"
          End
       End If
       Set FSO = New Scripting.FileSystemObject
       Set oFolder = FSO.GetFolder(FSO.GetParentFolderName(Application.UserLibraryPath) & "\Excel")
       For Each oFile In oFolder.Files
          If Right(oFile.Name, 4) = ".xlb" Then
             If datFile < oFile.DateLastAccessed Then
                datFile = oFile.DateLastAccessed
                sFile = oFile.Path
             End If
          End If
       Next oFile
       arrFile = Array(sFile, datFile)
       FindFile = arrFile
    End Function
    

    Dateiänderungsdatum der *.xlb-Datei ermitteln

    Bearbeiten
    • Prozedur: GetXLBDate
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Dateiänderungsdatum der XLB-Datei melden
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Funktion zur Ermittlung des Dateidatums aufrufen
      • Wenn ein Nullwert zurückgegeben wurde...
      • Negativmeldung
      • Sonst...
      • Meldung des Dateiänderungsdatums
    • Code:
    Sub GetXLBDate()
       Dim datFile As Date
       datFile = FindFile(1)
       If datFile = 0 Then
          MsgBox "Die *.xlb-Datei wurde nicht gefunden!"
       Else
          MsgBox "Letztes Änderungsdatum der *.xlb-Datei: " & vbLf & datFile
       End If
    End Sub
    


    Leeren und Löschen von Zellen

    Bearbeiten


    Über Dateieigenschaften

    Bearbeiten

    Über VBA-Prozeduren können Dateieigenschaften gelesen und geschrieben werden. Voraussetzung hierfür ist, dass das jeweilige Dokument geöffnet ist.

    Programmierbeispiele

    Bearbeiten

    Dateieigenschaften lesen

    Bearbeiten
    • Prozedur: ReadDocumentProperties
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Dateieigenschaften in eine Tabelle einlesen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Datenbereich leeren
      • Fehlerroutine starten
      • Rahmen um die BuiltInDocumentProperties bilden
      • Schleife über alle Elemente bilden
      • Den Namen der Eigenschaft eintragen
      • Den Wert der Eigenschaft eintragen
      • Den Typ der Eigenschaft eintragen
      • Wenn ein Fehler aufgetreten ist...
      • Den Fehlerwert eintragen
      • Fehler-Objekt zurücksetzen
      • Rahmen um die CustomDocumentProperties bilden
      • Schleife über alle Elemente bilden
      • Den Namen der Eigenschaft eintragen
      • Den Wert der Eigenschaft eintragen
      • Den Typ der Eigenschaft eintragen
      • Wenn ein Fehler aufgetreten ist...
      • Den Fehlerwert eintragen
      • Fehler-Objekt zurücksetzen
    • Code:
    Sub ReadDocumentProperties()
       Dim iRow As Integer
       Range("A4:F35").ClearContents
       On Error Resume Next
       With ActiveWorkbook.BuiltinDocumentProperties
          For iRow = 1 To .Count
             Cells(iRow + 3, 1).Value = .Item(iRow).Name
             Cells(iRow + 3, 2).Value = .Item(iRow).Value
             Cells(iRow + 3, 3).Value = .Item(iRow).Type
             If Err.Number <> 0 Then
                Cells(iRow + 3, 2).Value = CVErr(xlErrNA)
                Err.Clear
             End If
          Next iRow
       End With
       With ActiveWorkbook.CustomDocumentProperties
          For iRow = 1 To .Count
             Cells(iRow + 3, 5).Value = .Item(iRow).Name
             Cells(iRow + 3, 6).Value = .Item(iRow).Value
             Cells(iRow + 3, 7).Value = .Item(iRow).Type
             If Err.Number <> 0 Then
                Cells(iRow + 3, 6).Value = CVErr(xlErrNA)
                Err.Clear
             End If
          Next iRow
       End With
       On Error GoTo 0
    End Sub
    

    Dateieigenschaften schreiben

    Bearbeiten
    • Prozedur: WriteDocumentProperties
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Dateieigenschaften in eine Datei schreiben
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Aktives Blatt an eine Objekt-Variable übergeben
      • Wenn die Zelle A4 leer ist...
      • Warnton
      • Warnmeldung
      • Prozedur verlassen
      • Neue Arbeitsmappe anlegen
      • Rahmen um die BuiltInDocumentProperties bilden
      • Eine Schleife um den Datenbereich bilden
      • Wenn die Zelle in Spalte A der aktuellen Zeile leer ist, Prozedur verlassen
      • Wenn sich in Spalte B der aktuellen Zeile kein Fehlerwert befindet...
      • Wert für die Dateieigenschaft gem. Spalte A der aktuellen Zeile festlegen
      • Rahmen um die CustomDocumentProperties bilden
      • Eine Schleife um den Datenbereich bilden
      • Eine benutzerdefinierte Eigenschaft hinzufügen
      • Vollzugsmeldung anzeigen
    • Code:
    Sub WriteDocumentProperties()
       Dim wks As Worksheet
       Dim iRow As Integer
       Set wks = ActiveSheet
       If IsEmpty(Range("A4")) Then
          Beep
          MsgBox "Sie müssen zuerst die Eigenschaften einlesen!"
          Exit Sub
       End If
       Workbooks.Add
       With ActiveWorkbook.BuiltinDocumentProperties
          For iRow = 4 To 35
             If IsEmpty(wks.Cells(iRow, 1)) Then Exit For
             If IsError(wks.Cells(iRow, 2)) = False Then
                .Item(wks.Cells(iRow, 1).Value) = wks.Cells(iRow, 2).Value
             End If
          Next iRow
       End With
       With ActiveWorkbook.CustomDocumentProperties
          For iRow = 4 To 4
             .Add Name:=wks.Cells(iRow, 5).Value, LinkToContent:=False, _
                Type:=msoPropertyTypeDate, Value:=wks.Cells(iRow, 6).Value
          Next iRow
       End With
       MsgBox "Die editierbaren Dateieigenschaften wurden auf diese neue" & vbLf & _
          "Arbeitsmappe übertragen, bitte prüfen."
    End Sub
    

    Alle Dateieigenschaften ausgeben

    Bearbeiten

    Dateieigenschaften können eingebaute Dateieigenschaften sein (Auflistung der .BuiltinDocumentProperties), aber auch benutzerdefinierte Eigenschaften sein (Auflistung der .CustomDocumentProperties), die beispielsweise von anderen Programmen (wie NovaPath) geschrieben werden. Das folgende Programmierbeispiel zeigt, wie man im Hauptprogramm die gewünschte Auflistung als Objekt an das Unterprogramm übergeben wird. Im Unterprogramm wiederum werden alle Dateieigenschaften überprüft und ausgegeben, wenn vorhanden. Dieser Aufbau bietet sich an, weil beide Eigenschaftstypen über gleiche Methoden und Eigenschaften verfügen. Das Programm ermittelt alle Eigenschaften der aktiven Arbeitsmappe und gibt sie auf ein neues Blatt aus, welches dieser Arbeitsmappe angefügt wird.

    Die Switch-Anweisung ist die einzeilige Version der Select-Case-Anweisung.

    ' Listet alle Deteieigenschaften der aktiven Arbeitsmappe auf
    Public Sub DateiEigenschaftenAufzählen()
        ' Mappe, deren Eigenschaften ermittelt werden
        Dim Mappe           As Excel.Workbook
        
        ' Neues Blatt mit der Liste aller Eigenschaften
        Dim AusgabeBlatt    As Excel.Worksheet
        
        ' Zeile in der Ausgabemappe, in die gerade geschrieben wird
        Dim AusgabeZeileNr  As Long
        
        On Error Resume Next
        
        Set Mappe = ActiveWorkbook
        Set AusgabeBlatt = Mappe.Worksheets.Add
        
        AusgabeZeileNr = 2
        ' Eingebaute Eigenschaften auflisten
        EigenschaftenAusgeben Mappe.BuiltinDocumentProperties, _
            AusgabeBlatt, AusgabeZeileNr, "B"
        
        ' Benutzerdefinierte Eigenschaften auflisten
        EigenschaftenAusgeben Mappe.CustomDocumentProperties, _
            AusgabeBlatt, AusgabeZeileNr, "C"
        
        ' Kopfzeile der Ausgabetabelle formatieren
        With AusgabeBlatt.Range("A1:E1")
            .Value = Array("Typ", "ID", "Name", "Wert", "Datentyp")
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .EntireColumn.AutoFit
            .AutoFilter
            ' Blattname ändern:
            .Parent.Name = "DateiEigenschaften"
        End With
        
    End Sub
    
    Private Sub EigenschaftenAusgeben(EigenschaftsListe As Object, _
        AusgabeBlatt As Worksheet, ByRef AusgabeZeileNr As Long, Eingebaut As String)
        
        ' Zählvariable
        Dim EigenschaftsID  As Long
        
        On Error Resume Next
        
        ' Alle Eigenschaften durchgehen
        For EigenschaftsID = 1 To EigenschaftsListe.Count
            With EigenschaftsListe(EigenschaftsID)
                If .Name <> vbNullString Then ' Eigenschaft vorhanden
                    AusgabeBlatt.Cells(AusgabeZeileNr, 1).Value = Eingebaut
                    AusgabeBlatt.Cells(AusgabeZeileNr, 2).Value = EigenschaftsID
                    AusgabeBlatt.Cells(AusgabeZeileNr, 3).Value = .Name
                    AusgabeBlatt.Cells(AusgabeZeileNr, 4).Value = .Value
                    
                    ' Datentyp in Text übersetzen
                    AusgabeBlatt.Cells(AusgabeZeileNr, 5).Value = Switch(.Type = _
                                msoPropertyTypeDate, "Datum", _
                        .Type = msoPropertyTypeBoolean, "Boolscher Wert", _
                        .Type = msoPropertyTypeNumber, "Ganzzahl", _
                        .Type = msoPropertyTypeString, "Text", _
                        .Type = msoPropertyTypeFloat, "Gleitkommazahl")
                    
                    ' Nächste Zeile im Ausgabeblatt
                    AusgabeZeileNr = AusgabeZeileNr + 1
                End If
            End With
        Next EigenschaftsID
    End Sub
    

    Leeren und Löschen von Zellen

    Bearbeiten


    Löschen aller leeren Zellen einer Spalte

    Bearbeiten
    Sub DeleteEmptyCells() 
       Dim intLastRow As Integer    
       Dim intRow As Integer    
       intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
       For intRow = intLastRow To 1 Step -1  
          If Application.CountA(Rows(intRow)) = 0 Then  
             intLastRow = intLastRow - 1
          Else 
             Exit For  
          End If  
       Next intRow 
       For intRow = intLastRow To 1 Step -1  
          If IsEmpty(Cells(intRow, 1)) Then   
             Cells(intRow, 1).Delete xlShiftUp
          End If  
       Next intRow 
    End Sub
    

    Löschen der Zeile, wenn Zelle in Spalte A leer ist

    Bearbeiten
    Sub DeleteRowIfEmptyCell()  
       Dim intRow As Integer, intLastRow As Integer    
       intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
       For intRow = intLastRow To 1 Step -1  
          If Application.CountA(Rows(intRow)) = 0 Then  
             intLastRow = intLastRow - 1
          Else 
             Exit For  
          End If  
       Next intRow 
       For intRow = intLastRow To 1 Step -1  
          If IsEmpty(Cells(intRow, 1)) Then   
             Rows(intRow).Delete
          End If  
       Next intRow 
    End Sub
    

    Löschen aller leeren Zeilen

    Bearbeiten
    Sub DeleteEmptyRows() 
       Dim intRow As Integer, intLastRow As Integer    
       intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
       For intRow = intLastRow To 1 Step -1  
          If Application.CountA(Rows(intRow)) = 0 Then  
             Rows(intRow).Delete
          End If  
       Next intRow 
    End Sub
    

    FehlerZellen leeren

    Bearbeiten
    SubClearContentsErrorCells()  
       On Error GoTo ERRORHANDLER    
       Cells.SpecialCells(xlCellTypeFormulas, 16).ClearContents 
    ERRORHANDLER:
    End Sub
    

    FehlerZellen löschen

    Bearbeiten
    Sub ClearErrorCells()  
       On Error GoTo ERRORHANDLER    
       Cells.SpecialCells(xlCellTypeFormulas, 16).Delete xlShiftUp 
    ERRORHANDLER:
    End Sub
    

    Löschen aller Zellen in Spalte A mit "hallo" im Text

    Bearbeiten
    Sub DeleteQueryCells() 
       Dim var As Variant   
       Do While Not IsError(var)     
          var = Application.Match("hallo", Columns(1), 0)
          If Not IsError(var) Then Cells(var, 1).Delete xlShiftUp     
       Loop 
    End Sub
    

    Leeren aller Zellen mit gelbem Hintergrund

    Bearbeiten
    Sub ClearYellowCells() 
       Dim rng As Range   
       For Each rng In ActiveSheet.UsedRange    
          If rng.Interior.ColorIndex = 6 Then   
             rng.ClearContents
          End If  
       Next rng 
    End Sub
    

    Alle leeren Zellen löschen

    Bearbeiten
    Sub DeleteEmptys() 
       Dim rng As Range   
       Application.ScreenUpdating = False 
       For Each rng In ActiveSheet.UsedRange    
          If IsEmpty(rng) Then rng.Delete xlShiftUp  
       Next rng 
       Application.ScreenUpdating = True 
    End Sub
    

    XL4-Makros in VBA verwenden

    Bearbeiten


    Zum Aufruf von XL4-Makros in VBA

    Bearbeiten

    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

    Bearbeiten

    Tabelle FalseLinks

    Auslesen eines Wertes aus geschlossener Arbeitsmappe

    Bearbeiten
    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

    Bearbeiten
    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

    Bearbeiten
    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

    Bearbeiten
    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

    Bearbeiten
    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

    Bearbeiten

    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

    Bearbeiten

    Ü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

    Bearbeiten

    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

    Bearbeiten
    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

    Bearbeiten

    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

    Bearbeiten

    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

    Bearbeiten

    Ü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

    Bearbeiten

    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
    

    Textimport

    Bearbeiten


    Import zur Anzeige in MsgBoxes

    Bearbeiten

    Beim Import mit der Funktion Line Input sucht Excel nach Zeichen, die das Zeilenende ankündigen. Wurde eine Datei unter Windows geschrieben, endet eine Zeile üblicherweise mit zwei Zeichen: CHR(13) und CHR(10), also Wagenrücklauf (CR = Carriage Return) und Zeilenvorschub (LF = LineFeed). Mac-Dateien enden üblicherweise mit CHR(13) und Unix-Dateien enden üblicherweise mit CHR(10). 'Üblicherweise' meint, dass dies für Textdateien gilt, die das Betriebssystem schreibt und die als Konvention auch so von vielen Anwendungen von ihrem jeweiligen Betriebssystem übernommen wird. Es gibt aber auch Anwendungen, die auf mehreren Betriebssystemen laufen und andere oder überall die gleiche Konvention für das Zeilenende verwenden.

    Excel gibt es für Windows und Mac, daher werden von Line Input sowohl CR+LF als auch CR als Zeilenendzeichen erkannt. Ein einfaches LF oder andere Symbole werden versteht Excel nicht als Zeilenende und liest dann so lange ein, bis der Puffer voll ist – die eingelesene Zeichenfolge kann in diesem Falle mehrere zehntausend Byte lang werden.


    Sub WriteInMsgBoxes()  
       Dim cln As New Collection   
       Dim arrAct As Variant   
       Dim intNo As Integer, intCounter As Integer    
       Dim txt As String, strMsg As String   
       Dim bln As Boolean   
       intNo = FreeFile
       Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intNo      
       Do Until EOF(intNo)  
          If bln = False Then   
             Line Input #intNo, txt  
             arrAct = SplitString(txt, ",") 
             For intCounter = 1 To UBound(arrAct)  
                cln.Add arrAct(intCounter)
             Next intCounter 
          Else 
             Line Input #intNo, txt  
             arrAct = SplitString(txt, ",") 
             For intCounter = 1 To UBound(arrAct)  
                strMsg = strMsg & cln(intCounter) & ": " & _
                   arrAct(intCounter) & vbLf
             Next intCounter 
          End If  
          If bln Then MsgBox strMsg  
          bln = True 
          strMsg = ""
       Loop 
       Close intNo 
    End Sub
    

    Import zur Konvertierung in eine HTML-Seite

    Bearbeiten
    Sub WriteInHTML()  
       Dim arrAct As Variant   
       Dim intSource, intTarget, intCounter As Integer    
       Dim txt, strTag As String   
       Dim bln As Boolean   
       intTarget = FreeFile
       Open ThisWorkbook.Path & "\TextImport.htm" For Output As #intTarget     
       Print #intTarget, "<html><body><table>" 
       intSource = FreeFile
       Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intSource      
       Do Until EOF(intSource)  
          If bln Then strTag = "td" Else strTag = "th"   
          Line Input #intSource, txt  
          arrAct = SplitString(txt, ",") 
          Print #intTarget, "<tr>" 
          For intCounter = 1 To UBound(arrAct)  
             Print #intTarget, "<" & strTag & ">" & arrAct(intCounter) & "</" & strTag & ">" 
          Next intCounter 
          Print #intTarget, "</tr>" 
          bln = True 
       Loop 
       Close intSource 
       Print #intTarget, "</table></body></html>" 
       Close intTarget 
       Shell "hh " & ThisWorkbook.Path & "\TextImport.htm", vbMaximizedFocus 
    End Sub
    

    Import zur Anzeige in einem Arbeitsblatt

    Bearbeiten
    Sub WriteInWks()  
       Dim cln As New Collection   
       Dim arrAct As Variant   
       Dim intSource As Integer, intRow As Integer, intCol As Integer    
       Dim txt As String   
       Workbooks.Add
       intSource = FreeFile
       Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intSource      
       Do Until EOF(intSource)  
          Line Input #intSource, txt  
          arrAct = SplitString(txt, ",") 
          intRow = intRow + 1
          For intCol = 1 To UBound(arrAct)  
             Cells(intRow, intCol).Value = arrAct(intCol)
          Next intCol 
       Loop 
       Close intSource 
       Rows(1).Font.Bold = True 
    End Sub
    

    Import zur Übernahme in UserForm-Controls

    Bearbeiten

    In einem Standardmodul:

    Public garr() As String   
    Public gint As Integer
    

    Im Klassenmodul der UserForm:

    Private Sub cmdCancel_Click()  
       Unload Me
    End Sub  
    
    Private Sub cmdWeiter_Click()  
       Dim intCounter As Integer    
       If gint <= 4 Then gint = gint + 1 Else gint = 1   
       For intCounter = 1 To 5  
          Controls("TextBox" & intCounter).Text = garr(gint, intCounter)
       Next intCounter 
    End Sub  
    
    Private Sub UserForm_Initialize()    
       Dim arrAct As Variant   
       Dim intSource As Integer, intCounter As Integer, intRow As Integer    
       Dim txt As String   
       Dim bln As Boolean   
       gint = 0
       intSource = FreeFile
       Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intSource      
       Do Until EOF(intSource)  
          Line Input #intSource, txt  
          arrAct = SplitString(txt, ",") 
          If bln = False Then   
             For intCounter = 1 To UBound(arrAct)  
                Controls("Label" & intCounter).Caption = _
                   arrAct(intCounter) & ":"
             Next intCounter 
             ReDim garr(1 To 5, 1 To UBound(arrAct))   
          Else 
             intRow = intRow + 1
             For intCounter = 1 To UBound(arrAct)  
                garr(intRow, intCounter) = arrAct(intCounter)
             Next intCounter 
          End If  
          bln = True 
       Loop 
       Close intSource 
    End Sub
    

    Für alle vorstehende Routinen wird die folgende benutzerdefinierte Funktion in einem Standardmodul benötigt (Die Funktion macht unabhängig von der erst ab XL2000 verfügbaren VBA-Funktion Split:

    Function SplitString(ByVal txt As String, strSeparator As String)    
       Dim arr() As String   
       Dim intCounter As Integer    
       Do 
          intCounter = intCounter + 1
          ReDim Preserve arr(1 To intCounter)    
          If InStr(txt, strSeparator) Then   
             arr(intCounter) = Left(txt, InStr(txt, strSeparator) - 1) 
             txt = Right(txt, Len(txt) - InStr(txt, strSeparator)) 
          Else 
             arr(intCounter) = txt
             Exit Do  
          End If  
       Loop 
       SplitString = arr 
    End Function
    

    Sortieren

    Bearbeiten


    Auf die folgenden 3 Codes greifen mehrere der Sortierprogramme zu:

    Schnelle VBA-Sortierroutine

    Bearbeiten

    Autor: John Green

    Sub QuickSort(ByRef VA_array, Optional V_Low1, Optional V_High1)   
        Dim V_Low2 As Long, V_High2 As Long
        Dim V_val1 As Variant, V_val2 As Variant   
        If IsMissing(V_Low1) Then   
            V_Low1 = LBound(VA_array, 1)
        End If  
        If IsMissing(V_high1) Then   
            V_High1 = UBound(VA_array, 1)
        End If  
        V_Low2 = V_Low1
        V_High2 = V_High1
        V_val1 = VA_array((V_Low1 + V_High1) / 2)
        While (V_Low2 <= V_High2) 
            While (VA_array(V_Low2) < V_val1 And _  
                V_Low2 < V_High1)
                V_Low2 = V_Low2 + 1
            Wend 
            While (VA_array(V_High2) > V_val1 And _  
                V_High2 > V_Low1)
                V_High2 = V_High2 - 1
            Wend 
            If (V_Low2 <= V_High2) Then  
                V_val2 = VA_array(V_Low2)
                VA_array(V_Low2) = VA_array(V_High2)
                VA_array(V_High2) = V_val2
                V_Low2 = V_Low2 + 1
                V_High2 = V_High2 - 1
            End If  
        Wend 
        If (V_High2 > V_Low1) Then Call _   
            QuickSort(VA_array, V_Low1, V_High2)
        If (V_Low2 < V_High1) Then Call _   
            QuickSort(VA_array, V_Low2, V_High1)
    End Sub
    

    Dialog zur Verzeichnisauswahl

    Bearbeiten
    Public Type BROWSEINFO 
       hOwner As Long  
       pidlRoot As Long  
       pszDisplayName As String  
       lpszTitle As String  
       ulFlags As Long  
       lpfn As Long  
       lParam As Long  
       iImage As Long  
    End Type 
    
    Declare Function SHGetPathFromIDList Lib "shell32.dll" _   
       Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _    
       ByVal pszPath As String) As Long    
    
    Declare Function SHBrowseForFolder Lib "shell32.dll" _   
       Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long    
    
    Function GetDirectory(Optional msg) As String     
       Dim bInfo As BROWSEINFO   
       Dim Path As String   
       Dim r As Long, x As Long, pos As Integer     
       bInfo.pidlRoot = 0& 
       If IsMissing(msg) Then   
          bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."  
       Else 
          bInfo.lpszTitle = msg 
       End If  
       bInfo.ulFlags = &H1 
       x = SHBrowseForFolder(bInfo)  
       Path = Space$(512)
       r = SHGetPathFromIDList(ByVal x, ByVal Path)  
       If r Then  
          pos = InStr(Path, Chr$(0)) 
          GetDirectory = Left(Path, pos - 1) 
       Else 
          GetDirectory = "" 
       End If  
    End Function
    

    Auslesen der Dateinamen in einem Verzeichnis

    Bearbeiten
    Function FileArray(strPath As String, strPattern As String)   
       Dim arrDateien() 
       Dim intCounter As Integer    
       Dim strDatei As String   
       If Right(strPath, 1) <> "\" Then strPath = strPath & "\"  
       strDatei = Dir(strPath & strPattern)
       Do While strDatei <> ""  
           intCounter = intCounter + 1
           ReDim Preserve arrDateien(1 To intCounter)    
           arrDateien(intCounter) = strDatei
           strDatei = Dir()
       Loop 
       If intCounter = 0 Then  
          ReDim arrDateien(1)  
          arrDateien(1) = False 
       End If  
       FileArray = arrDateien
    End Function
    

    Sortieren der Dateien eines Verzeichnisses nach Dateiname

    Bearbeiten
    Sub CallQuickSortFilesA()  
       Dim arr As Variant   
       Dim intCounter As Integer    
       Dim strPath As String   
       strPath = GetDirectory("Bitte Verzeichnis auswählen:") 
       If strPath = "" Then Exit Sub    
       arr = FileArray(strPath, "*.*")
       If arr(1) = False Then   
          Beep
          MsgBox "Keine Dateien gefunden!"
          Exit Sub  
       End If  
       QuickSort arr
       Columns("A:B").ClearContents
       For intCounter = 1 To UBound(arr)  
          Cells(intCounter, 1) = arr(intCounter)
       Next intCounter 
       Columns(1).AutoFit
    End Sub
    

    Sortieren der Dateien eines Verzeichnisses nach Dateidatum

    Bearbeiten
    Sub CallQuickSortFilesB()  
       Dim arrDate() As Variant   
       Dim arr As Variant   
       Dim intCounter As Integer    
       Dim strPath As String   
       strPath = GetDirectory("Bitte Verzeichnis auswählen:") 
       If strPath = "" Then Exit Sub    
       arr = FileArray(strPath, "*.*")
       If arr(1) = False Then   
          Beep
          MsgBox "Keine Dateien gefunden!"
          Exit Sub  
       End If  
       Columns("A:B").ClearContents
       ReDim arrDate(1 To 2, 1 To UBound(arr))   
       For intCounter = 1 To UBound(arr)  
          arrDate(1, intCounter) = arr(intCounter)
          arrDate(2, intCounter) = FileDateTime(strPath & arr(intCounter))
       Next intCounter 
       Columns(1).ClearContents
       For intCounter = 1 To UBound(arr)  
          Cells(intCounter, 1) = arrDate(1, intCounter)
          Cells(intCounter, 2) = arrDate(2, intCounter)
       Next intCounter 
       Range("A1").CurrentRegion.Sort key1:=Range("B1"), _
          order1:=xlAscending, header:=xlNo  
       Columns("A:B").AutoFit
    End Sub
    

    Sortieren der Arbeitsblätter der aktiven Arbeitsmappe

    Bearbeiten
    Sub CallQuickSortWks()  
       Dim arr() As String   
       Dim intCounter As Integer    
       ReDim arr(1 To Worksheets.Count)   
       For intCounter = 1 To Worksheets.Count  
          arr(intCounter) = Worksheets(intCounter).Name
       Next intCounter 
       QuickSort arr
       For intCounter = UBound(arr) To 1 Step -1  
          Worksheets(arr(intCounter)).Move before:=Worksheets(1)
       Next intCounter 
    End Sub
    

    Sortieren einer Tabelle nach einer benutzerdefinierten Sortierfolge

    Bearbeiten
    Sub SortBasedOnCustomList()  
       Application.AddCustomList ListArray:=Range("B2:B14") 
       Range("A16:B36").Sort _ 
          key1:=Range("B17"), _ 
          order1:=xlAscending, _ 
          header:=xlYes, _
          OrderCustom:=Application.CustomListCount + 1 
       Application.DeleteCustomList Application.CustomListCount
    End Sub
    

    Sortieren einer Datums-Tabelle ohne Einsatz der Excel-Sortierung

    Bearbeiten
    Sub CallQuickSortDate()  
       Dim arr(1 To 31) As Date    
       Dim intRow As Integer    
       For intRow = 2 To 32  
          arr(intRow - 1) = Cells(intRow, 1)
       Next intRow 
       Call QuickSort(arr) 
       For intRow = 2 To 32  
          Cells(intRow, 1).Value = arr(intRow - 1)
       Next intRow 
    End Sub
    

    Sortieren einer Tabelle nach sechs Sortierkriterien

    Bearbeiten
    Sub SortSixColumns() 
       Dim intCounter As Integer    
       For intCounter = 2 To 1 Step -1  
          Range("A1").CurrentRegion.Sort _ 
             key1:=Cells(1, intCounter * 3 - 2), _
             order1:=xlAscending, _ 
             key2:=Cells(1, intCounter * 3 - 1), _
             order2:=xlAscending, _ 
             key3:=Cells(1, intCounter * 3), _
             order3:=xlAscending, _ 
             header:=xlNo
       Next intCounter 
    End Sub
    

    Sortieren mit Ae vor Ä und Sch vor S

    Bearbeiten
    Sub SpecialSort() 
       With Columns("A") 
          .Replace What:="Ä", Replacement:="Ae", LookAt:=xlPart, SearchOrder _ 
              :=xlByRows, MatchCase:=True  
          .Replace What:="Sch", Replacement:="Rzz", LookAt:=xlPart, _
              SearchOrder:=xlByRows, MatchCase:=True   
          .Sort key1:=Range("A2"), order1:=xlAscending, header:=xlGuess, _  
              OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom    
          .Replace What:="Rzz", Replacement:="Sch", LookAt:=xlPart, _
              SearchOrder:=xlByRows, MatchCase:=True   
          .Replace What:="Ae", Replacement:="Ä", LookAt:=xlPart, SearchOrder _ 
               :=xlByRows, MatchCase:=True  
       End With  
    End Sub
    

    Sortieren nach der Häufigkeit des Vorkommens

    Bearbeiten

    Sortieren einschließlich der ausgeblendeten Zeilen

    Bearbeiten
    Sub SortAll() 
       Dim rngHidden As Range   
       Dim lngLastRow As Long, lngRow As Long   
       Application.ScreenUpdating = False 
       Set rngHidden = Rows(1) 
       lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row 
       For lngRow = 1 To lngLastRow  
          If Rows(lngRow).Hidden = True Then   
             Set rngHidden = Union(rngHidden, Rows(lngRow)) 
          End If  
       Next lngRow 
       rngHidden.EntireRow.Hidden = False 
       Range("A1").CurrentRegion.Sort key1:=Range("A2"), _ 
          order1:=xlAscending, header:=xlYes 
       rngHidden.EntireRow.Hidden = True 
       Rows(1).Hidden = False 
       Application.ScreenUpdating = True 
    End Sub
    

    Sortieren mehrerer Tabellenblattbereiche

    Bearbeiten
    Sub MultiSort() 
       Dim intRow As Integer    
       For intRow = 1 To 19 Step 6  
          Range(Cells(intRow, 1), Cells(intRow + 4, 8)).Sort _ 
             key1:=Cells(intRow + 1, 7), _
             order1:=xlAscending, header:=xlYes 
       Next intRow 
    End Sub
    

    Direkter Aufruf des Sortierdialogs

    Bearbeiten
    Sub CallSortDialogA()  
       Application.Dialogs(xlDialogSort).Show
    End Sub
    

    Aufruf des Sortierdialogs unter Einsatz der Sortier-Schaltfläche

    Bearbeiten
    Sub CallSortDialogB()  
       Range("A1").Select  
       CommandBars.FindControl(ID:=928).Execute
    End Sub
    

    Sortieren per Matrixfunktion

    Bearbeiten

    Author: Stefan Karrmann

    Function MatrixSort(ByRef arr As Variant, ByVal column As Long) As Variant()
        MatrixSort = arr.Value2
        Call QuickSortCol(MatrixSort, column)
    End Function
    
    Sub QuickSortCol(ByRef VA_array, Optional ByVal column As Long, _
                    Optional V_Low1, Optional V_high1)
        ' On Error Resume Next
        Dim V_Low2, V_high2, V_loop As Integer
        Dim V_val1 As Variant
        Dim tmp As Variant
        Dim ColLow As Long, colHigh As Long, col As Long
        
        If IsMissing(column) Then
            column = 1
        End If
        
        ColLow = LBound(VA_array, 2)
        colHigh = UBound(VA_array, 2)
        If IsMissing(V_Low1) Then
            V_Low1 = LBound(VA_array, 1)
        End If
        If IsMissing(V_high1) Then
            V_high1 = UBound(VA_array, 1)
        End If
        V_Low2 = V_Low1
        V_high2 = V_high1
        V_val1 = VA_array((V_Low1 + V_high1) / 2, column)
        While (V_Low2 <= V_high2)
            While (V_Low2 < V_high1 _
               And VA_array(V_Low2, column) < V_val1)
                V_Low2 = V_Low2 + 1
            Wend
            While (V_high2 > V_Low1 _
               And VA_array(V_high2, column) > V_val1)
                V_high2 = V_high2 - 1
            Wend
            If (V_Low2 <= V_high2) Then
                For col = ColLow To colHigh
                    tmp = VA_array(V_Low2, col)
                    VA_array(V_Low2, col) = VA_array(V_high2, col)
                    VA_array(V_high2, col) = tmp
                Next col
                V_Low2 = V_Low2 + 1
                V_high2 = V_high2 - 1
            End If
        Wend
        If (V_high2 > V_Low1) Then Call _
            QuickSortCol(VA_array, column, V_Low1, V_high2)
        If (V_Low2 < V_high1) Then Call _
            QuickSortCol(VA_array, column, V_Low2, V_high1)
    End Sub
    

    Stringfolge sortieren

    Bearbeiten

    Author: Markus Wilmes

    Sub DemoStrSort()
       Dim strSort As String
       strSort = "ak dv ad sf ad fa af dd da fa d1 25 24 ad fx "
       Call QuickSortStr(strSort, 3)
       MsgBox strSort
    End Sub
    
    Sub QuickSortStr(ByRef strToSort As String, Optional ByVal lngLen, Optional ByVal lngLow, Optional ByVal lngHigh)
       Dim lngCLow  As Long
       Dim lngCHigh As Long
       Dim lngPos   As Long
       Dim varA     As Variant
       Dim varB     As Variant
       If IsMissing(lngLen) Then
          lngLen = 1
       End If
       If IsMissing(lngLow) Then
          lngLow = 0
       End If
       If IsMissing(lngHigh) Then
          lngHigh = (Len(strToSort) / lngLen) - 1
       End If
       lngCLow = lngLow
       lngCHigh = lngHigh
       lngPos = Int((lngLow + lngHigh) / 2)
       varA = Mid(strToSort, (lngPos * lngLen) + 1, lngLen)
       While (lngCLow <= lngCHigh)
          While (Mid(strToSort, (lngCLow * lngLen) + 1, lngLen) < varA And lngCLow < lngHigh)
             lngCLow = lngCLow + 1
          Wend
          While (Mid(strToSort, (lngCHigh * lngLen) + 1, lngLen) > varA And lngCHigh > lngLow)
             lngCHigh = lngCHigh - 1
          Wend
          If (lngCLow <= lngCHigh) Then
             varB = Mid(strToSort, (lngCLow * lngLen) + 1, lngLen)
             Mid(strToSort, (lngCLow * lngLen) + 1, lngLen) = Mid(strToSort, (lngCHigh * lngLen) + 1, lngLen)
             Mid(strToSort, (lngCHigh * lngLen) + 1, lngLen) = varB
             lngCLow = lngCLow + 1
             lngCHigh = lngCHigh - 1
          End If
       Wend
       If (lngCHigh > lngLow) Then
          Call QuickSortStr(strToSort, lngLen, lngLow, lngCHigh)
       End If
       If (lngCLow < lngHigh) Then
          Call QuickSortStr(strToSort, lngLen, lngCLow, lngHigh)
       End If
    End Sub
    

    Beispiele für Schleifen

    Bearbeiten


    Siehe auch: VBA in Excel/_Schleifen

    Allgemeines / Einleitung

    Bearbeiten

    Schleifen sind zentraler Bestandteil jeder Programmiersprache. Anhand von Schleifen ist es möglich, Programmanweisungen mehrmals hintereinander zu wiederholen.

    Beispiel einer Programmierung ohne Schleifeneinsatz:
       Cells(1, 1).Value = "ZEILE 1"
       Cells(2, 1).Value = "ZEILE 2"
       Cells(3, 1).Value = "ZEILE 3"
       Cells(4, 1).Value = "ZEILE 4"
       Cells(5, 1).Value = "ZEILE 5"
       Cells(6, 1).Value = "ZEILE 6"
    
    Beispiel der gleichen Programmierung mit Schleifeneinsatz:
       For iCounter = 1 To 6
          Cells(iCounter, 1).Value = "Zeile " & iCounter
       Next iCounter
    

    Unter anderem kann der Codeumfang somit erheblich reduziert werden, wie im vorhergehenden Beispiel zu sehen ist. Weitere Vorteile werden anhand der unterschiedlichen Schleifenarten ersichtlich (z.B. variable Anzahl an Durchläufen). Grundsätzlich gibt es zwei Arten von Schleifen, die Zählschleifen (die Anzahl der Schleifendurchläufe wird durch eine Variable oder konstante Zahl bestimmt) und Prüfschleifen (die Schleife wird durchlaufen solange eine Bedingung wahr bzw. falsch ist).

    Grundlagenwissen zu Schleifen lässt sich hier nachlesen: Wikipedia: Schleifen (Programmierung)

    Schleifentypen-Beispiele

    Bearbeiten

    Jeder Schleifentyp kann weitere Bedingungsprüfungen enthalten. Bei Zählschleifen kann die Schrittgröße festgelegt werden; der Default-Wert ist 1.

    Zählschleifen

    Bearbeiten

    For-To-Next-Schleife

    Bearbeiten
    • Prozedur: ForNextCounter
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zähler hochzählen und Einzelwerte berechnen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Schleifenbeginn
      • Wert berechnen und addieren
      • Schleifenende
      • Ergebnisausgabe
    • Code:
    Sub ForNextCounter()
       Dim dValue As Double
       Dim iCounter As Integer
       For iCounter = 1 To 100
          dValue = dValue + iCounter * 1.2
       Next iCounter
       MsgBox "Ergebnis: " & dValue
    End Sub
    

    For...To...Next-Schleife mit Schrittgrößenangabe nach vorn

    Bearbeiten
    • Prozedur: ForNextStepForward
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zähler schrittweise hochzählen
    • Ablaufbeschreibung:
    • Variablendeklaration
      • Schleifenbeginn
      • Wert ausgeben
      • Schleifenende
    • Code:
    Sub ForNextStepForward()
       Dim iCounter As Integer
       For iCounter = 1 To 10 Step 2
          MsgBox iCounter
       Next iCounter
    End Sub
    


    For...To...Next-Schleife mit Schrittgrößenangabe zurück

    Bearbeiten
    • Prozedur: ForNextStepBack
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zähler schrittweise hochzählen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Schleifenbeginn
      • Wert ausgeben
      • Schleifenende
    • Code:
    Sub ForNextStepBack()
       Dim iCounter As Integer
       For iCounter = 10 To 1 Step -3
          MsgBox iCounter
       Next iCounter
    End Sub
    

    Schleifen mit vorangestellter Bedingungsprüfung

    Bearbeiten

    While ... Wend-Schleife

    Bearbeiten
    • Prozedur: WhileWend
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zellen durchlaufen und Einzelwerte berechnen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Startwert setzen
      • Schleifenbeginn
      • Wert berechnen und addieren
      • Zeilenzähler hochzählen
      • Schleifenende
      • Wert ausgeben
    • Code:
    Sub WhileWend()
       Dim iRow As Integer
       Dim dValue As Double
       iRow = 1
       While Not IsEmpty(Cells(iRow, 1))
          dValue = dValue + Cells(iRow, 1).Value * 1.2
          iRow = iRow + 1
       Wend
       MsgBox "Ergebnis: " & dValue
    End Sub
    


    Do ... Loop-Schleife

    Bearbeiten
    • Prozedur: DoLoop
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zellen durchlaufen und Einzelwerte berechnen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Startwert setzen
      • Schleifenbeginn
      • Wert berechnen und addieren
      • Bedingung prüfen
      • Zeilenzähler hochzählen
      • Schleifenende
      • Wert ausgeben
    • Code:
    Sub DoLoop()
       Dim iRow As Integer
       Dim dValue As Double
       iRow = 1
       Do
          dValue = dValue + Cells(iRow, 1).Value * 1.2
          If IsEmpty(Cells(iRow + 1, 1)) Then Exit Do
          iRow = iRow + 1
       Loop
       MsgBox "Ergebnis: " & dValue
    End Sub
    

    Do ... While-Schleife

    Bearbeiten
    • Prozedur: DoWhile
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zellen durchlaufen und Einzelwerte berechnen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Startwert setzen
      • Schleifenbeginn mit Bedingung
      • Wert berechnen und addieren
      • Zeilenzähler hochzählen
      • Schleifenende
      • Wert ausgeben
    • Code:
    Sub DoWhile()
       Dim iRow As Integer
       Dim dValue As Double
       iRow = 1
       Do While Not IsEmpty(Cells(iRow, 1))
          dValue = dValue + Cells(iRow, 1).Value * 1.2
          iRow = iRow + 1
       Loop
       MsgBox "Ergebnis: " & dValue
    End Sub
    

    Do-Until-Schleife

    Bearbeiten
    • Prozedur: DoUntil
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zellen durchlaufen und Einzelwerte berechnen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Startwert setzen
      • Schleifenbeginn mit Bedingung
      • Wert berechnen und addieren
      • Zeilenzähler hochzählen
      • Schleifenende
      • Wert ausgeben
    • Code:
    Sub DoUntil()
       Dim iRow As Integer
       Dim dValue As Double
       iRow = 1
       Do Until IsEmpty(Cells(iRow, 1))
          dValue = dValue + Cells(iRow, 1).Value * 1.2
          iRow = iRow + 1
       Loop
       MsgBox "Ergebnis: " & dValue
    End Sub
    

    Schleifen mit nachgestellter Bedingungsprüfung

    Bearbeiten

    Do-Until-Schleife

    Bearbeiten
    • Prozedur: DoUntil
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zellen durchlaufen und Einzelwerte berechnen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Startwert setzen
      • Schleifenbeginn
      • Wert berechnen und addieren
      • Zeilenzähler hochzählen
      • Schleifenende mit Bedingung
      • Wert ausgeben
    • Code:
    Sub DoLoopWhile()
       Dim iRow As Integer
       Dim dValue As Double
       iRow = 1
       Do
          dValue = dValue + Cells(iRow, 1).Value * 1.2
          iRow = iRow + 1
       Loop While Not IsEmpty(Cells(iRow - 1, 1))
       MsgBox "Ergebnis: " & dValue
    End Sub
    

    Weitere Schleifen mit nachgestellter Bedingungsprüfung

    Bearbeiten

    Do-Loop-Until-Schleife

    Bearbeiten
    • Prozedur: DoLoopUntil
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zellen durchlaufen und Einzelwerte berechnen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Startwert setzen
      • Schleifenbeginn
      • Wert berechnen und addieren
      • Zeilenzähler hochzählen
      • Schleifenende mit Bedingung
      • Wert ausgeben
    • Code:
    Sub DoLoopUntil()
       Dim iRow As Integer
       Dim dValue As Double
       iRow = 1
       Do
          dValue = dValue + Cells(iRow, 1).Value * 1.2
          iRow = iRow + 1
       Loop Until IsEmpty(Cells(iRow, 1))
       MsgBox "Ergebnis: " & dValue
    End Sub
    

    Objektbezogene Beispiele

    Bearbeiten

    Einsatz bei Arbeitsmappen- und Tabellenobjekte

    Bearbeiten

    Ausgabe der Arbeitsblattnamen der aktiven Arbeitsmappe

    Bearbeiten
    • Prozedur: EachWks
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Arbeitsblattnamen der aktiven Arbeitsmappe ausgeben
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Schleifenbeginn
      • Ausgabe der Namen
      • Schleifenende
    • Code:
    Sub EachWks()
       Dim wks As Worksheet
       For Each wks In Worksheets
          MsgBox wks.Name
       Next wks
    End Sub
    

    Ausgabe der Arbeitsblattnamen alle geöffneten Arbeitsmappen

    Bearbeiten
    • Prozedur: EachWkbWks
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Arbeitsblattnamen aller geöffneten Arbeitsmappe ausgeben
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Schleifenbeginn Arbeitsmappen
      • Schleifenbeginn Arbeitsblätter
      • Ausgabe der Namen
      • Schleifenende Arbeitblätter
      • Schleifenende Arbeitsmappen
    • Code:
    Sub EachWkbWks()
       Dim wkb As Workbook
       Dim wks As Worksheet
       For Each wkb In Workbooks
          For Each wks In wkb.Worksheets
             MsgBox wkb.Name & vbLf & "   -" & wks.Name
          Next wks
       Next wkb
    End Sub
    

    Ausgabe der integrierten Dokumenteneigenschaften der aktiven Arbeitsmappe

    Bearbeiten
    • Prozedur: EachWkbWks
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Integrierte Dokumenteneigenschaften der aktiven Arbeitsmappe ausgeben
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Fehlerroutine
      • Schleifenbeginn
      • Ausgabe der Namen
      • Schleifenende
      • Ende der Fehlerroutine
    • Code:
    Sub EachDPWkb()
       Dim oDP As DocumentProperty
       On Error Resume Next
       For Each oDP In ThisWorkbook.BuiltinDocumentProperties
          MsgBox oDP.Name & ": " & oDP.Value
       Next oDP
       On Error GoTo 0
    End Sub
    

    Ausgabe der Formatvorlagen der aktiven Arbeitsmappe

    Bearbeiten
    • Prozedur: EachWkbWks
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Formatvorlagen der aktiven Arbeitsmappe ausgeben
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Schleifenbeginn
      • Wert ausgeben
      • Schleifenende
    • Code:
    Sub EachStylesWkb()
       Dim oStyle As Style
       For Each oStyle In ThisWorkbook.Styles
          MsgBox oStyle.Name
       Next oStyle
    End Sub
    

    Ausgabe der einzelnen Zelladressen eines vorgegebenen Bereiches

    Bearbeiten
    • Prozedur: EachWkbWks
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Zelladressen eines vorgegebenen Bereiches ausgeben
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Schleifenbeginn
      • Wert ausgeben
      • Schleifenende
    • Code:
    Sub EachCellWks()
       Dim rng As Range
       For Each rng In Range("A1:B2")
          MsgBox rng.Address(rowabsolute:=False, columnabsolute:=False)
       Next rng
    End Sub
    

    Einsatz bei tabellenintegrierten Steuerelement-Objekten

    Bearbeiten

    Prüfung, welches Optionsfeld in einer vorgegebenen Gruppe von Optionsfeldgruppen aktiviert ist

    Bearbeiten
    • Prozedur: EachWks
    • Art: Sub
    • Modul: Klassenmodul der Tabelle
    • Zweck: Ausgabe des Namens des aktivierten Optionsfelds einer vorgegenen Optionsfeldgruppe
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Schleife über alle Steuerelemente der Tabelle
      • Prüfung des Typnamens des Steuerelements
      • Wenn es sich um ein Optionsfeld handelt...
      • Übergabe an eine Objektvariable
      • Wenn das Optionsfeld aktiviert ist und es sich um ein Steuerelement von der Gruppe GroupB handelt...
      • Ausgabe des Namens des Steuerelements
      • Schleifenende
    • Code:
    Sub IfSelected()
       Dim oOle As OLEObject
       Dim oOpt As msforms.OptionButton
       For Each oOle In OLEObjects
          If TypeName(oOle.Object) = "OptionButton" Then
             Set oOpt = oOle.Object
             If oOpt And oOpt.GroupName = "GroupB" Then
                MsgBox "In GroupB ist " & oOpt.Caption & " aktiviert"
             End If
          End If
       Next oOle
    End Sub
    

    Einsatz bei Userform-Steuerelement-Objekten

    Bearbeiten

    Prüfung, welche CheckBox-Elemente einer UserForm aktiviert sind

    Bearbeiten
    • Prozedur: cmdRead_Click
    • Art: Sub
    • Modul: Klassenmodul der UserForm
    • Zweck: Ausgabe des Namen aktivierter CheckBox-Elemente einer UserForm
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Schleife über alle Steuerelemente der UserForm
      • Wenn es sich um eine CheckBox handelt...
      • Wenn die CheckBox aktiviert ist...
      • Einlesen des CheckBox-Namens in eine String-Variable
      • Schleifenende
      • Wenn keine aktivierte CheckBoxes gefunden wurden...
      • Negativmeldung
      • Sonst...
      • Ausgabe des oder der Namen der aktivierten CheckBoxes
    • Code:
    Private Sub cmdRead_Click()
       Dim oCntr As msforms.Control
       Dim sMsg As String
       For Each oCntr In Controls
          If TypeName(oCntr) = "CheckBox" Then
             If oCntr Then
                sMsg = sMsg & "   " & oCntr.Name & vbLf
             End If
          End If
       Next oCntr
       If sMsg = "" Then
          MsgBox "Es wurde keine CheckBox aktiviert!"
       Else
          MsgBox "Aktivierte CheckBoxes:" & vbLf & sMsg
       End If
    End Sub
    

    Bedingtes Einlesen von ListBox-Elementen in eine zweite ListBox

    Bearbeiten
    • Prozedur: cmdAction_Click
    • Art: Sub
    • Modul: Klassenmodul der UserForm
    • Zweck: Ausgabe des Namens aktivierter CheckBox-Elemente einer UserForm
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Schleife über alle Listelemente des ersten Listenfelds
      • Wenn das Listenelement den Bedingungen entspricht...
      • Übergabe an das zweite Listenfeld
      • Schleifenende
    • Code:
    Private Sub cmdAction_Click()
       Dim iCounter As Integer
       For iCounter = 0 To lstAll.ListCount - 1
          If CDate(lstAll.List(iCounter)) &gt;= CDate(txtStart) And _
             CDate(lstAll.List(iCounter)) &lt;= CDate(txtEnd) Then
             lstFilter.AddItem lstAll.List(iCounter)
          End If
       Next iCounter
    End Sub
    
    Bearbeiten

    Rechtschreibprüfung

    Bearbeiten


    Die CheckSpelling-Methode

    Bearbeiten

    Die CheckSpelling-Methode kann aufgerufen werden mit:

    • Syntax1: Ausdruck.CheckSpelling([CustomDictionary], [IgnoreUppercase], [AllwaysSuggest], [SpellLanguage])
      • CustomDictionary: Das Benutzer-Wörterbuch (optional)
        Eingerichtet sind zwei (am Anfang leere) Wörterbücher:
        • BENUTZER.DIC für die deutsche Sprachversion
        • custom.dic für die englische Sprachversion
          Neue Wörterbücher können hinzugefügt werden.
      • IgnoreUppercase: Groß/Kleinschreibung ignorieren (optional)
      • AllwaysSuggest: Schreibweise vorschlagen (optional)
      • Sprache: Die zugrundzulegende Sprache

        Die möglichen Sprachversionen ergeben sich aus dem Rechtschreibungs-Dialog und sind in der Regel:
        • Deutsch (Deutschland)
        • Deutsch (Österreich)
        • Deutsch (Schweiz)
        • Englisch (Australien)
        • Englisch (Großbritannien)
        • Englisch (Kanada)
        • Englisch (USA)
        • Französisch (Frankreich)
        • Französisch (Kanada)
        • Italienisch (Italien)
    • Syntax2:
      Ausdruck.CheckSpelling(Word, [CustomDictionary], [IgnoreUppercase])
      Word: Der zu prüfende Begriff
      Wird als Ausdruck Application vorgegeben, kommt Syntax 2 zur Anwendung.

    Wort prüfen

    Bearbeiten
    • Prozedur: CheckWord
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Einzelwort prüfen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Fehlerroutine initalisieren
      • Prüfbegriff festlegen
      • Wenn der Prüfbegriff nicht gefunden wurde...
      • Negativmeldung
      • Sonst...
      • Positivmeldung
      • Prozedur beenden
      • Start Fehlerroutine
      • Fehlermeldung
    • Code:
    Sub CheckWord()
       Dim sWorth As String
       On Error GoTo ERRORHANDLER
       sWorth = Range("A1").Value
       If Not Application.CheckSpelling( _
          word:=sWorth, _
          customdictionary:="BENUTZER.DIC", _
          ignoreuppercase:=False) Then
          MsgBox "Keine Entsprechung für das Wort " & sWorth & " gefunden!"
       Else
          MsgBox "Das Wort " & sWorth & " ist vorhanden!"
       End If
       Exit Sub
    ERRORHANDLER:
       Beep
       MsgBox _
          prompt:="Die Rechtschreibprüfung ist nicht installiert!"
    End Sub
    

    Wort auf englisch prüfen

    Bearbeiten
    • Prozedur: SpellLanguage
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Englisches Einzelwort prüfen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Aktuelle Spracheinstellung einlesen
      • Wenn es sich um die Excel-Version 7.0 handelt zum 1. Errorhandler springen
      • Initialisierung des 2. Errorhandlers
      • Prüfbegriff einlesen
      • Wenn der Prüfbegriff nicht im kanadisch-englischen Wörterbuch gefunden wurde...
      • Negativmeldung
      • Sonst...
      • Positivmeldung
      • Prüfsprache auf aktuelle Office-Spracheinstellung setzen
      • Prozedur beenden
      • Erster Errorhandler
      • Zweiter Errorhandler
    • Code:
    Sub SpellLanguage()
       Dim lLang As Long
       Dim sWorth As String
       Dim bln As Boolean
       lLang = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
       If Left(Application.Version, 1) = "7" Then GoTo ERRORHANDLER1
       On Error GoTo ERRORHANDLER2
       sWorth = Range("A2").Value
       If Not Range("A2").CheckSpelling( _
          customdictionary:="BENUTZER.DIC", _
          ignoreuppercase:=False, _
          spelllang:=3081) Then
          MsgBox "Keine Entsprechung für das Wort " & sWorth & " gefunden!"
       Else
          MsgBox "Das Wort " & sWorth & " ist entweder vorhanden" & vbLf & _
             "oder es wurde keine Korrektur gewünscht!"
       End If
       bln = Range("A2").CheckSpelling("Test", spelllang:=lLang)
       Exit Sub
    ERRORHANDLER1:
       MsgBox "Die Sprachfestlegung ist erst ab XL9 möglich!"
       Exit Sub
    ERRORHANDLER2:
       Beep
       MsgBox _
          prompt:="Die Rechtschreibprüfung ist nicht installiert!"
    End Sub
    

    Steuerelement-TextBox prüfen

    Bearbeiten

    Bitte beachten: OLEObjekte lassen sich nicht über die CheckSpelling-Methode ansprechen, ihre Texte müssen ausgelesen werden.

    • Prozedur: CheckTxtBoxA
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Den Inhalt einer TextBox aus der Steuerelement-ToolBox prüfen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Eine Schleife über alle OLEObjekte des aktiven Blattes bilden
      • Wenn es sich um eine TextBox handelt...
      • TextBox-Inhalt in eine String-Variable einlesen
      • Funktion zum Aufsplitten des Textes in Einzelwörter aufrufen (bei Excel-Versionen ab XL2000 kann hier die VBA-Split-Funktion eingesetzt werden)
      • Eine Schleife über alle Einzelwörter bilden
      • Wenn das Wort nicht gefunden wurde...
      • Negativmeldung
    • Code:
    Sub CheckTxtBoxA()
       Dim oTxt As OLEObject
       Dim arrWrd() As String, sTxt As String
       Dim iCounter As Integer
       For Each oTxt In ActiveSheet.OLEObjects
          If TypeOf oTxt.Object Is MSForms.TextBox Then
             sTxt = oTxt.Object.Text
             arrWrd = MySplit(sTxt, " ")
             For iCounter = 1 To UBound(arrWrd)
                If Not Application.CheckSpelling( _
                   word:=arrWrd(iCounter), _
                   customdictionary:="BENUTZER.DIC", _
                   ignoreuppercase:=False) Then
                   MsgBox arrWrd(iCounter) & " aus der TextBox " _
                      & oTxt.Name & " wurde nicht im Wörterbuch gefunden!"
                End If
             Next iCounter
          End If
       Next oTxt
    End Sub
    

    Zeichnen-TextBox global prüfen

    Bearbeiten
    • Prozedur: CheckTxtBoxB
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Den Inhalt einer TextBox aus der Zeichnen-Symbolleiste global prüfen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Wenn alle Wörter des TextBox-Inhalts gefunden wurden...
      • Positivmeldung
      • Sonst...
      • Negativmeldung
    • Code:
    Sub CheckTxtBoxB()
       If Application.CheckSpelling( _
          word:=ActiveSheet.TextBoxes("txtSpelling").Text, _
          customdictionary:="BENUTZER.DIC", _
          ignoreuppercase:=False) Then
          MsgBox "Alle Wörter wurden gefunden!"
       Else
          MsgBox "Mindestens ein Wort wurde nicht gefunden!"
       End If
    End Sub
    

    Zeichnen-TextBox einzeln prüfen

    Bearbeiten

    Bitte beachten: OLEObjekte lassen sich nicht über die CheckSpelling-Methode ansprechen, ihre Texte müssen ausgelesen werden.

    • Prozedur: CheckTxtBoxC
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Alle Wörter aus einer TextBox aus der Zeichnen-Symbolleiste einzeln prüfen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • TextBox-Inhalt in eine String-Variable einlesen
      • Funktion zum Aufsplitten des Textes in Einzelwörter aufrufen (bei Excel-Versionen ab XL2000 kann hier die VBA-Split-Funktion eingesetzt werden)
      • Eine Schleife über alle Einzelwörter bilden
      • Wenn das Wort nicht gefunden wurde...
      • Negativmeldung
    • Code:
    Sub CheckTxtBoxC()
       Dim arrWrd() As String, sTxt As String
       Dim iCounter As Integer
       sTxt = ActiveSheet.TextBoxes("txtSpelling").Text
       arrWrd = MySplit(sTxt, " ")
       For iCounter = 1 To UBound(arrWrd)
          If Not Application.CheckSpelling( _
             word:=arrWrd(iCounter), _
             customdictionary:="BENUTZER.DIC", _
             ignoreuppercase:=False) Then
             MsgBox arrWrd(iCounter) & " aus der TextBox " & _
                "txtSpelling wurde nicht im Wörterbuch gefunden!"
          End If
       Next iCounter
    End Sub
    

    Zellbereich prüfen

    Bearbeiten
    • Prozedur: CheckRange
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Einen Zellbereich global prüfen
    • Ablaufbeschreibung:
      • Wenn alle Wörter eines Bereiches gefunden wurden...
      • Positivmeldung
      • Sonst...
      • Negativmeldung
    • Code:
    Sub CheckRange()
       If Range("A4:A8").CheckSpelling Then
          MsgBox "Entweder alle Wörter wurden gefunden" & vbLf & _
             "oder es wurde keine Korrektur gewünscht!"
       Else
          MsgBox "Es wurden nicht alle Wörter aus dem Bereich A4:A8 gefunden!"
       End If
    End Sub
    

    Gültigkeitsfestlegungen prüfen

    Bearbeiten
    • Prozedur: CheckValidation
    • Art: Sub
    • Modul: Standardmodul
    • Zweck: Eingabe- und Fehlermeldungstexte einer Gültigkeitsfestlegung prüfen
    • Ablaufbeschreibung:
      • Variablendeklaration
      • Zelle mit Gültigkeitsprüfung an eine Objektvariable übergeben
      • Wenn die Zelle eine Gültigkeitsprüfung enthält...
      • Fehlermeldungs-Text in Stringvariable einlesen
      • Wenn eine Fehlermeldung festgelegt wurde...
      • Funktion zum Aufsplitten des Textes in Einzelwörter aufrufen (bei Excel-Versionen ab XL2000 kann hier die VBA-Split-Funktion eingesetzt werden)
      • Eine Schleife über alle Wörter bilden
      • Wenn das jeweilige Wort nicht gefunden wurde...
      • Negativmeldung
      • Eingabe-Text in Stringvariable einlesen
      • Wenn ein Eingabetext festgelegt wurde...
      • Funktion zum Aufsplitten des Textes in Einzelwörter aufrufen (bei Excel-Versionen ab XL2000 kann hier die VBA-Split-Funktion eingesetzt werden)
      • Eine Schleife über alle Wörter bilden
      • Wenn das jeweilige Wort nicht gefunden wurde...
      • Negativmeldung
    • Code:
    Sub CheckValidation()
       Dim rng As Range
       Dim arrWrd() As String, sTxt As String
       Dim iCounter As Integer
       Set rng = Range("A10")
       If Abs(rng.Validation.Type) >= 0 Then
          sTxt = rng.Validation.ErrorMessage
          If sTxt &lt;&gt; vbNullString Then
             arrWrd = MySplit(sTxt, " ")
             For iCounter = 1 To UBound(arrWrd)
                If Not Application.CheckSpelling( _
                   word:=arrWrd(iCounter), _
                   customdictionary:="BENUTZER.DIC", _
                   ignoreuppercase:=False) Then
                   MsgBox arrWrd(iCounter) & " aus der Fehlermeldung " & _
                      "wurde nicht im Wörterbuch gefunden!"
                End If
             Next iCounter
          End If
          sTxt = rng.Validation.InputMessage
          Erase arrWrd
          If sTxt &lt;&gt; vbNullString Then
             arrWrd = MySplit(sTxt, " ")
             For iCounter = 1 To UBound(arrWrd)
                If Not Application.CheckSpelling( _
                   word:=arrWrd(iCounter), _
                   customdictionary:="BENUTZER.DIC", _
                   ignoreuppercase:=False) Then
                   MsgBox arrWrd(iCounter) & " aus der Eingabemeldung " & _
                      "wurde nicht im Wörterbuch gefunden!"
                End If
             Next iCounter
          End If
       End If
    End Sub
    

    UserForm-TextBox prüfen

    Bearbeiten
      • Prozedur: cmdSpelling_Click
      • Art: Sub
      • Modul: Klassenmodul der UserForm
      • Zweck: Inhalt einer UserForm-TextBox prüfen
      • Ablaufbeschreibung:
        • Variablendeklaration
        • TextBox-Text in eine String-Variable einlesen
        • Funktion zum Aufsplitten des Textes in Einzelwörter aufrufen (bei Excel-Versionen ab XL2000 kann hier die VBA-Split-Funktion eingesetzt werden)
        • Schleife über alle Wörter bilden
        • Wenn das jeweilige Wort nicht gefunden wurde...
        • Negativmeldung
        • Schleife verlassen
        • Wenn ein Wort nicht gefunden wurde...
        • Rahmen mit der TextBox bilden
        • Den Focus der TextBox zuordnen
        • Erstes Zeichen für die Textmarkierung festlegen
        • Länge der Textmarkierung festlegen
      • Code:
      Private Sub cmdSpelling_Click()
         Dim arrWrd() As String, sTxt As String, sWhole As String
         Dim lChar As Long
         Dim iCounter As Integer
         sTxt = txtSpelling.Text
         sWhole = sTxt
         arrWrd = MySplit(sTxt, " ")
         For iCounter = 1 To UBound(arrWrd)
            If Not Application.CheckSpelling( _
               word:=arrWrd(iCounter), _
               customdictionary:="BENUTZER.DIC", _
               ignoreuppercase:=False) Then
               MsgBox arrWrd(iCounter) & " aus der TextBox " & _
                  "txtSpelling wurde nicht im Wörterbuch gefunden!"
               lChar = InStr(sWhole, arrWrd(iCounter))
               Exit For
            End If
         Next iCounter
         If lChar > 0 Then
            With txtSpelling
               .SetFocus
               .SelStart = lChar - 1
               .SelLength = Len(arrWrd(iCounter))
            End With
         End If
      End Sub
      

      Bei Eingabe Rechtschreibprüfung aufrufen

      Bearbeiten
      • Prozedur: Worksheet_Change
      • Art: Sub
      • Modul: Klassenmodul des Arbeitsblattes
      • Zweck: Bei Zelleingabe in Spalte A die Rechtschreibprüfung aufrufen
      • Ablaufbeschreibung:
        • Wenn die Eingabezelle in Spalte A liegt, dann...
        • Warnmeldungen ausschalten
        • Rechtschreibprüfung aufrufen
        • Wanrmeldungen einschalten
      • Code:
      Private Sub Worksheet_Change(ByVal Target As Range)
         If Target.Column = 1 Then
            Application.DisplayAlerts = False
            Target.CheckSpelling
            Application.DisplayAlerts = True
         End If
      End Sub
      

      Bei Doppelklick Rechtschreibprüfung aufrufen

      Bearbeiten
      • Prozedur: Worksheet_BeforeDoubleClick
      • Art: Sub
      • Modul: Klassenmodul des Arbeitsblattes
      • Zweck: Bei Doppelklick in Spalte B die Rechtschreibprüfung aufrufen
      • Ablaufbeschreibung:
        • Wenn die Eingabezelle in Spalte B liegt, dann...
        • Doppelklick-Voreinstellung ausschalten
        • Warnmeldungen ausschalten
        • Rechtschreibprüfung aufrufen
        • Wanrmeldungen einschalten
      • Code:
      Private Sub Worksheet_BeforeDoubleClick( _
         ByVal Target As Range, Cancel As Boolean)
         If Target.Column = 2 Then
            Cancel = True
            Application.DisplayAlerts = False
            Target.CheckSpelling
            Application.DisplayAlerts = True
         End If
      End Sub
      

      Beim Schließen jeder Arbeitsmappe eine Rechtschreibprüfung durchführen

      Bearbeiten

      Der nachfolgende Code muß in die Personl.xls eingegeben werden, damit er für alle nach Sitzungsstart zu öffnenden und zu schließenden Arbeitsmappen Gültigkeit hat.

      Im Klassenmodul der Arbeitsmappe:

      Bearbeiten
      Dim xlApplication As New clsApp
      
      Private Sub Workbook_BeforeClose(Cancel As Boolean)
         Set xlApplication.xlApp = Nothing
      End Sub
      
      Private Sub Workbook_Open()
         Set xlApplication.xlApp = Application
         Call CreateCmdBar
      End Sub
      

      In einem Klassenmodul mit dem Namen clsApp:

      Bearbeiten
      Public WithEvents xlApp As Excel.Application
      
      Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Excel.Workbook, _
         Cancel As Boolean)
         Dim wks As Worksheet
         For Each wks In Wb.Worksheets
            wks.CheckSpelling
         Next
      End Sub
      


      Weitere Beispiele

      Bearbeiten


      Belegte Zellen bestimmen

      Bearbeiten

      Mit dem nachfolgenden Beispiel können die erste und letzte belegte Zelle in einer Zeile bestimmt werden. Klicken Sie eine beliebige Zeile an und starten das Makro. Ein Meldungsfenster gibt Ihnen Auskunft, welches die erste und letzte belegte Zelle der angeklickten Zeile ist.

      Sub ErsteUndLetzteBelegteZelleInZeile()
          Dim lngSpalte1&, lngSpalte2 As Long: Dim strAusgabetext As String    
          lngSpalte1 = Cells(ActiveCell.Row, 1).End(xlToRight).Column
          lngSpalte2 = Cells(ActiveCell.Row, Rows(ActiveCell.Row).Cells.Count).End(xlToLeft).Column
          If IsEmpty(Cells(ActiveCell.Row, 1)) = False Then lngSpalte1 = 1    
          strAusgabetext = Switch(lngSpalte1 = Rows(ActiveCell.Row).Cells.Count And lngSpalte2 = 1, _
              "Zeile " & ActiveCell.Row & " ist leer.", lngSpalte1 >= 1 And lngSpalte2 > lngSpalte1, _
              "In der angeklickten Zeile ist die erste belegte Zelle " & Cells(ActiveCell.Row, _
              lngSpalte1).Address(False, False) & vbCr & " mit dem Wert " & _
               Cells(ActiveCell.Row, lngSpalte1) & " und die letzte Zelle ist " & _
              Cells(ActiveCell.Row, lngSpalte2).Address(False, False) & vbCr & " mit dem Wert " & _
              Cells(ActiveCell.Row, lngSpalte2) & ".", lngSpalte1 = lngSpalte2, _
              "Es ist nur Zelle " & Cells(ActiveCell.Row, lngSpalte1).Address(False, False) & _
              " mit dem Wert " & Cells(ActiveCell.Row, lngSpalte1) & " belegt.")        
          MsgBox strAusgabetext, vbInformation
      End Sub
      

      Add-In installieren

      Sub InstallAddIn()
              Dim AddInNeu As AddIn        
              On Error Resume Next
              Set AddInNeu = AddIns.Add(Filename:=Environ("AppData") & "\Microsoft\AddIns\neuesAddIn.xlam")
              AddInNeu.Installed = True
              MsgBox AddInNeu.Title & " wurde installiert."
              Exit Sub
      ErrorHandler:
              MsgBox "An error occurred."
      End Sub
      

      Add-In deinstallieren

      Sub AddinEinbinden()
          Application.AddIns("neuesAddIn").Installed = False
      End Sub
      

      Add-In schließen

      Sub addInSchließen()
          On Error Resume Next
          Workbooks("neuesAddIn.xlam").Close
      End Sub
      

      Variablentyp bestimmen

      Bearbeiten

      Klicken Sie eine belegte Zelle eines Arbeitsblatts an. Mit dem Makro können Sie den Variablentyp einer Zelle bestimmen.

      Sub ZellenWerttypErmitteln()
          Dim strVariablentyp As String
          Dim byteIndex As Byte    
          byteIndex = VarType(ActiveCell)    
          strVariablentyp = Choose(byteIndex + 1, "Empty", "Null", "Integer", "Long", _
              "Single", "Double", "Currency", "Date", "String", "Object", "Error", "Boolean")    
          MsgBox strVariablentyp    
      End Sub
      

      Arbeitsblattexistenz bestimmen

      Bearbeiten

      Mit diesem Makro können Sie die Existenz eines Tabellenblatts überprüfen. Wenn Sie in die zweite Inputbox keinen Mappennamen eintragen, wird unterstelltt, dass die Existenz des eingegebenen Tabellenblatts in der aktivierten Mappe geprüft werden soll. (Beachte: der zu überprüfende BlattCodename ist nicht identisch mit dem Tabellennamen (wie auf dem Tabellenregisterblatt). Sie können den jeweiligen BlattCodenamen im Projektexplorer herausfinden. Der Blattcodename ist Tabelle1, Tabelle2 usw.) Verweis: Microsoft Visual Basic for Applications Extensibility

      Function BlattDa(strBlattCodename As String, Optional Mappe As Workbook) As Boolean   
          If Mappe Is Nothing Then
              Set Mappe = ActiveWorkbook
          Else
              For Each Workbook In Application.Workbooks
                  If Mappe.Name = Workbook.Name Then Set Mappe = Workbook
              Next Workbook
          End If   
          For Each Worksheet In Mappe.Worksheets
              If Mappe.VBProject.VBComponents(Worksheet.CodeName).Name = strBlattCodename Then
                  BlattDa = True
              End If
          Next Worksheet
      End Function
      
      Sub CheckForSheet()
          Dim boolBlattDa As Boolean
          Dim strMappenname$
          Dim strBlattCodename$
          strBlattCodename = InputBox("Gebe den Blattcodenamen ein")
          If strBlattCodename = "" Then Exit Sub
          strMappenname = InputBox("Gebe den Namen der geöffneten Mappe ohne Dateiendung ein! " & _
              "Falls Sie nichts eintragen und ok klicken, wird die aktuelle Mappe geprüft!")
          If strMappenname <> "" Then
              On Error Resume Next
              If Workbooks(strMappenname) Is Nothing Then
                  MsgBox "Die Mappe ist nicht geöffnet oder existiert nicht", vbCritical
                  Exit Sub
              End If
          End If
          If strMappenname = "" Then
              boolBlattDa = BlattDa(strBlattCodename)
          Else
              boolBlattDa = BlattDa(strBlattCodename, Workbooks(strMappenname))
          End If
          If boolBlattDa Then
              MsgBox "Das Blatt existiert!"
          Else
              MsgBox "The worksheet does NOT exist!"
          End If
      End Sub
      

      Tabellenlisten mit Anwenderformular editieren

      Bearbeiten

      Erzeugen Sie händisch oder per VBA-Makro eine Tabellenliste und fügen das erste Makro in das Codemodul des verwendeten Arbeitsblatts ein.

      Danach erstellen Sie ein Anwenderformular Userform1 und platzieren darauf ein Listenfeld, drei Befehlsschaltflächen Commandbutton1 - 3 und für jede zu editierende Tabellenspalte jeweils ein Texteingabefeld Textbox.

      CommandButton1 - Caption: Zeile hinzufügen CommandButton2: Caption: Zeile ändern CommandButton3: Caption: Zeile löschen Um das Makro zu starten, klicken Sie doppelt auf die Tabellenliste.


      Codemodul des verwendeten Arbeitsblatts

      Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
          Dim strListobjectname
          On Error Resume Next
          If Selection.ListObject.Name = "" Then
              MsgBox "Keine Tabellenliste angeklickt"
              Exit Sub
          Else
              strListobjectname = Selection.ListObject.Name
          End If
          Load UserForm1
          With UserForm1
              .Caption = "Verkaufsliste"
              .Show
          End With
      End Sub
      


      Codemodul des Anwenderformulars, Name: Userform1

      Private strListobjectname$
      
      Sub ListenfeldFüllen()
          Dim i%, intSpaltenzahl%, sngSpaltenbreite!(), varSpaltenbreiten
          intSpaltenzahl = ActiveSheet.ListObjects(strListobjectname).ListColumns.Count
          For i = 0 To intSpaltenzahl - 1
              ReDim Preserve sngSpaltenbreite(i)
              sngSpaltenbreite(i) = ActiveSheet.ListObjects(strListobjectname).ListColumns(i + 1).Range.ColumnWidth
          Next i
          With Me
              With .ListBox1
                      .Clear
                      .ListStyle = fmListStylePlain
                      .ColumnCount = intSpaltenzahl
                      .ColumnHeads = True
                      For i = 0 To intSpaltenzahl - 1
                          varSpaltenbreiten = varSpaltenbreiten & CStr(sngSpaltenbreite(i) / 5.3 & " cm;")
                      Next i
                      .Font.Size = 10.5
                      .ColumnWidths = varSpaltenbreiten
                      Call RowSourceEinstellen
                  End With
              End With
      End Sub
      
      Sub RowSourceEinstellen()
          With ListBox1
              .RowSource = ActiveSheet.ListObjects(strListobjectname).Range.Address
              If ActiveSheet.ListObjects(strListobjectname).Range.Rows.Count > 1 Then
                  .RowSource = ActiveSheet.ListObjects(strListobjectname).Range.Offset(1, 0).Resize( _
                      ActiveSheet.ListObjects(strListobjectname).Range.Rows.Count - 1).Address(External:=True)
              End If
          End With
      End Sub
      
      Private Sub CommandButton1_Click()
          Dim Listzeile As ListRow, Bereich As Range, i%, j&, tb As MSForms.Control
          Set Listzeile = ActiveSheet.ListObjects(strListobjectname).ListRows.Add
          Set Bereich = ActiveSheet.ListObjects(strListobjectname).ListRows(Listzeile.Index).Range
          i = 1: j = Listzeile.Index
          For Each tb In Me.Controls
              If TypeName(tb) = "TextBox" Then
                  Bereich(i) = tb.Text
                  i = i + 1
              End If
          If i > ActiveSheet.ListObjects(strListobjectname).ListColumns.Count Then Exit For
          Next tb
          Call RowSourceEinstellen
          ListBox1.Selected(j - 1) = True
          For Each tb In Me.Controls
              If TypeName(tb) = "TextBox" Then
                  tb.Text = ""
              End If
          Next tb
      End Sub
      
      Private Sub CommandButton2_Click()
          Dim i%, j&, Bereich As Range, varBereich() As Variant, tb As MSForms.Control
          i = 1
          If ListBox1.ListIndex = -1 Then ListBox1.Selected(0) = True
          j = ListBox1.ListIndex
          On Error Resume Next
          Set Bereich = ActiveSheet.ListObjects(strListobjectname).ListRows(Me.ListBox1.ListIndex + 1).Range
          For Each tb In Me.Controls
              If TypeName(tb) = "TextBox" Then
                  ReDim Preserve varBereich(i)
                  varBereich(i) = tb.Text
                  i = i + 1
              End If
              If i > ActiveSheet.ListObjects(strListobjectname).ListColumns.Count Then Exit For
          Next tb
          For i = 1 To UBound(varBereich)
               Bereich(i) = varBereich(i)
          Next i
          Call RowSourceEinstellen
          ListBox1.Selected(j) = True
          For Each tb In Me.Controls
              If TypeName(tb) = "TextBox" Then
                  tb.Text = ""
              End If
          Next tb
      End Sub
      
      Private Sub CommandButton3_Click()
          Dim i&, tb As MSForms.Control
          i = ListBox1.ListIndex
          On Error Resume Next
          ActiveSheet.ListObjects(strListobjectname).ListRows(Me.ListBox1.ListIndex + 1).Delete
          Call RowSourceEinstellen
          On Error Resume Next
          ListBox1.Selected(i - 1) = True
          For Each tb In Me.Controls
              If TypeName(tb) = "TextBox" Then
                  tb.Text = ""
              End If
          Next tb
      End Sub
      
      Private Sub ListBox1_click()
          Dim i%, Bereich As Range, tb As MSForms.Control
          i = 1
          On Error Resume Next
          Set Bereich = ActiveSheet.ListObjects(strListobjectname).ListRows(Me.ListBox1.ListIndex + 1).Range
          For Each tb In Me.Controls
              If TypeName(tb) = "TextBox" Then
                  tb.Text = Bereich(i)
                  i = i + 1
              End If
              If i > ActiveSheet.ListObjects(strListobjectname).ListColumns.Count Then Exit For
          Next tb
      End Sub
      
      Private Sub UserForm_Initialize()
          strListobjectname = Selection.ListObject.Name
          Call ListenfeldFüllen
      End Sub
      


      Tabellenlistenzeilen scrollen

      Bearbeiten

      Erzeugen Sie ein Drehfeld und erzeugen per Makro zum Testen eine Tabellenliste. Die letztgenannten Makros kopieren Sie in das Codemodul des verwendeten Arbeitsblatts.


      Standardmodul

      Sub SpinbuttonEinfügen()
          Dim cb As OLEObject
      
          Set cb = ActiveSheet.OLEObjects.Add(ClassType:="Forms.SpinButton.1", Link:=False, _
          DisplayAsIcon:=False, Left:=413.25, Top:=86.25, Width:=28.5, Height:=33)
      End Sub
      
      Sub CreateTable()
          [a1] = "Produkt":    [b1] = "Verkäufer": [c1] = "Verkaufsmenge"
          [a2] = "Navigation": [b2] = "Schröder":  [c2] = 1
          [a3] = "Handy":      [b3] = "Schmied":   [c3] = 10
          [a4] = "Navigation": [b4] = "Müller":    [c4] = 20
          [a5] = "Navigation": [b5] = "Schmied":   [c5] = 30
          [a6] = "Handy":      [b6] = "Müller":    [c6] = 40
          [a7] = "iPod":       [b7] = "Schmied":   [c7] = 50
          [a8] = "Navigation": [b8] = "Schröder":  [c8] = 60
          [a9] = "Handy":      [b9] = "Becker":    [c9] = 70
          [a10] = "iPod":     [b10] = "Müller":   [c10] = 80
          On Error Resume Next
          ActiveSheet.ListObjects.Add(xlSrcRange, Range("$a$1:$c$10"), , xlYes).Name = _
              "Table1"
          ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight2"
      End Sub
      

      Codemodul des Arbeitsblatts mit der Tabellenliste

      Private lo As ListObject, lr As ListRow
      Private lngSpinbutton1Max, lngSpinSelected&
      
      Private Sub Worksheet_Activate()
          Call Werte
      End Sub
      
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
          Call Werte
      End Sub
      
      Private Sub SpinButton1_SpinUp()
          Call swap
      End Sub
      
      Private Sub SpinButton1_SpinDown()
          Call swap
      End Sub
      
      Private Sub Werte()
              If Not Intersect(ActiveCell, ListObjects(1).DataBodyRange) Is Nothing Then
              
              SpinButton1.Max = ActiveSheet.ListObjects(Selection.ListObject.Name).ListRows.Count
              SpinButton1.Min = 1
              lngSpinbutton1Max = SpinButton1.Max
              Set lo = ActiveSheet.ListObjects("Table1")
              For Each lr In lo.ListRows
                  If Not Intersect(lr.Range, ActiveCell) Is Nothing Then
                      SpinButton1.Value = lngSpinbutton1Max + 1 - lr.Index
                      lngSpinSelected = lr.Index
                      Exit For
                  End If
              Next lr
          End If
      End Sub
      
      Private Sub swap()
          Dim lngSpinNeu&
          Dim ZeileNeu As Range, ZeileAlt As Range
          Dim varZeileNeu As Variant, varZeileAlt As Variant, varMerkZeile
          
          On Error Resume Next
          If Not Intersect(ActiveCell, ListObjects(Selection.ListObject.Name).DataBodyRange) Is Nothing Then
             lngSpinNeu = SpinButton1.Max + 1 - SpinButton1.Value
             If lngSpinNeu <> lngSpinSelected Then
                  Set ZeileNeu = ActiveSheet.ListObjects(Selection.ListObject.Name).ListRows(lngSpinNeu).Range
                  Set ZeileAlt = ActiveSheet.ListObjects(Selection.ListObject.Name).ListRows(lngSpinSelected).Range
                  varZeileNeu = ZeileNeu
                  varZeileAlt = ZeileAlt
                  
                  varMerkZeile = varZeileNeu
                  varZeileNeu = varZeileAlt
                  varZeileAlt = varMerkZeile
                  
                  ZeileAlt = varZeileAlt
                  ZeileNeu = varZeileNeu
                  lngSpinSelected = lngSpinNeu
                  ActiveSheet.ListObjects(Selection.ListObject.Name).ListRows(lngSpinSelected).Range.Select
                  
              End If
          End If
      End Sub
      

      Exceldaten in XML-Dokument exportieren

      Bearbeiten

      Soweit mit Ihrer Office-Version XML mitgeliefert wurde, setzen Sie einen Verweis auf Microsoft XML. Dieses Makro verwendet die Version 6.0. Bei Version 5.0 verwenden Sie die Variablendeklaration Domdocument50.


      Sub Excel_XML()
          Dim xml As New MSXML2.domdocument60
          Dim xmlKnoten As MSXML2.IXMLDOMElement
          Dim xmlUnterknoten As MSXML2.IXMLDOMElement
          Dim Zelle As Range, strWert$, strNeu$, i%
          Cells.Clear
          [a1] = "Produkt":    [b1] = "Verkäufer": [c1] = "Verkaufsmenge"
          [a2] = "Navigation": [b2] = "Schröder":  [c2] = 1
          [a3] = "Handy":      [b3] = "Schmied":   [c3] = 10
          [a4] = "Navigation": [b4] = "Müller":    [c4] = 20
          [a5] = "Navigation": [b5] = "Schmied":   [c5] = 30
          [a6] = "Handy":      [b6] = "Müller":    [c6] = 40
          [a7] = "iPod":       [b7] = "Schmied":   [c7] = 50
          [a8] = "Navigation": [b8] = "Schröder":  [c8] = 60
          [a9] = "Handy":      [b9] = "Becker":    [c9] = 70
          [a10] = "iPod":     [b10] = "Müller":   [c10] = 80   
          xml.LoadXML "<?xml version=""1.0"" " & " encoding=""ISO-8859-1""?><meineXMLListe/>"
          For Each Row In [a2:c10].Rows    
              Set xmlKnoten = xml.createElement("Knoten")        
              For Each Zelle In [a1:c1].Columns
                  Zelle.Value = Replace(Zelle.Value, "ä", "ae")
                  Zelle.Value = Replace(Zelle.Value, "Ä", "Ae")
                  Zelle.Value = Replace(Zelle.Value, "ö", "oe")
                  Zelle.Value = Replace(Zelle.Value, "Ö", "Oe")
                  Zelle.Value = Replace(Zelle.Value, "ü", "ue")
                  Zelle.Value = Replace(Zelle.Value, "Ü", "Ue")           
                  For i = 1 To Len(Zelle.Value)           
                      If Mid(Zelle.Value, i, 1) Like "[a-z]" Or Mid(Zelle.Value, i, 1) Like "[A-Z]" Or _
                          Mid(Zelle.Value, i, 1) Like "[0-9]" Or Mid(Zelle.Value, i, 1) Like "_" Then _
                              strNeu = strNeu & Mid(Zelle.Value, i, 1)
                  Next i
                  Set xmlUnterknoten = xml.createElement(strNeu)
                  xmlKnoten.appendChild(xmlUnterknoten).Text = Cells(Row.Row, Zelle.Column).Value
                  strNeu = ""
              Next Zelle
              xml.DocumentElement.appendChild xmlKnoten
          Next Row  
          xml.Save Environ("tmp") & "\meineXMLDatei.xml"
          Set xml = Nothing: Set xmlKnoten = Nothing: Set xmlUnterknoten = Nothing
      End Sub
      

      XML-Daten in Excelblatt importieren

      Bearbeiten

      Erzeugen Sie mit dem ersten Makro die Schema-Definition. Der Import erfolgt dann mit dem zweiten Makro, das die Schema-Definition verwendet.

      Sub Create_XSD()
          Dim strMyXml As String, meinMap As XmlMap
          Dim strMeinSchema$
          strMyXml = "<meineXMLListe>" & _
                      "<Knoten>" & _
                      "<Produkt>Text</Produkt>" & _
                      "<Verkaeufer>Text</Verkaeufer>" & _
                      "<Verkaufsmenge>999</Verkaufsmenge>" & _
                      "</Knoten>" & _
                      "<Knoten></Knoten>" & _
                      "</meineXMLListe>"
          Application.DisplayAlerts = False
          Set meinMap = ThisWorkbook.XmlMaps.Add(strMyXml)
          Application.DisplayAlerts = True
          strMeinSchema = meinMap.Schemas(1).xml
          Open ThisWorkbook.Path & "\strMeinSchema.xsd" For Output As #1
          Print #1, strMeinSchema
          Close #1
      End Sub
      
      Sub CreateXMLList()
          Dim Map1 As XmlMap
          Dim objList As ListObject
          Dim objColumn As ListColumn
          Dim i%    
          If Dir(ThisWorkbook.Path & "\strMeinSchema.xsd") = "" Then Exit Sub
          Set Map1 = ThisWorkbook.XmlMaps.Add(ThisWorkbook.Path & "\strMeinSchema.xsd")   
          On Error Resume Next
          ActiveSheet.ListObjects(1).Delete
          Application.DisplayAlerts = False
          ActiveSheet.Range("A1").Select
          Set objList = ActiveSheet.ListObjects.Add
          objList.ListColumns(1).XPath.SetValue Map1, "/meineXMLListe/Knoten/Produkt"   
          Set objColumn = objList.ListColumns.Add
          objColumn.XPath.SetValue Map1, "/meineXMLListe/Knoten/Verkaeufer"    
          Set objColumn = objList.ListColumns.Add
          objColumn.XPath.SetValue Map1, "/meineXMLListe/Knoten/Verkaufsmenge"   
          objList.ListColumns(1).Name = "Produkt"
          objList.ListColumns(2).Name = "Verkäufer"
          objList.ListColumns(3).Name = "Verkaufsmenge"
          Columns.AutoFit
          Application.DisplayAlerts = False   
          Map1.Import (Environ("tmp") & "\meineXMLDatei.xml")
      End Sub
      

      oder:

      Standardmodul

      Public Sub GetOverwrite()
          Dim clsOverwrite As New Klasse1
          Cells.Clear
      
          On Error Resume Next
          clsOverwrite.GetXMLData
      End Sub
      

      Klassenmodul, Name: Klasse1

      Public Function GetXMLData() As Variant
          Dim strXmlQuelldatei$
          Dim XmlImportResult As XlXmlImportResult
          
          strXmlQuelldatei = Environ("tmp") & "\meineXMLDatei.xml"
          
          If Dir(strXmlQuelldatei) = vbNullString Then MsgBox "Die Quelldatei wurde nicht gefunden"
          
          XmlImportResult = ActiveWorkbook.XmlImport(strXmlQuelldatei, Nothing, _
               True, ActiveCell)
          If XmlImportResult = xlXmlImportSuccess Then MsgBox "XML Datenimport komplett"
      End Function
      

      Exceldaten in Access-Datenbank exportieren

      Bearbeiten
      Sub neueDatenbankErzeugen()   
          Dim cat As New ADOX.Catalog
          Dim tbl As New ADOX.Table
          Dim strPfad$
          strPfad = Environ("localAPPDATA") & "\microsoft\office\pivotTabelle.accdb"
          If Dir(strPfad) = "" Then _
              cat.Create "Provider = microsoft.ace.oledb.12.0; data source=" & strPfad    
          With tbl
              .ParentCatalog = cat
              .Name = "Früchteverkauf"        
              With .Columns
                  .Append "Frucht", adVarWChar, 60
                  .Append "Monat", adVarWChar, 10
                  .Append "Menge", adInteger
              End With        
              .Columns("Menge").Properties("Nullable") = True
          End With    
          cat.Tables.Append tbl       
          Set tbl = Nothing
          Set cat = Nothing
      End Sub
      
      Sub DatenHinzufügenADO()
          Dim conn As New ADODB.Connection
          Dim rs As New ADODB.Recordset
          Dim Row As Range, Column As Range
          Dim strPfad$    
          strPfad = Environ("localAPPDATA") & "\microsoft\office\pivotTabelle.accdb"    
          If Dir(strPfad) = "" Then Exit Sub    
          With ActiveSheet        
              .Cells.Clear
              .[a1] = "Frucht":    .[B1] = "Jan.":  .[C1] = "Feb.":  .[D1] = "Mär."
              .[A2] = "Äpfel":     .[B2] = 5:       .[C2] = 3:       .[D2] = 4
              .[a3] = "Orangen":   .[B3] = 4:                        .[D3] = 5
              .[A4] = "Birnen":    .[B4] = 2:       .[C4] = 3:       .[D4] = 5  
              conn.Open "Provider=Microsoft.ace.OLEDB.12.0;" & _
                    "Data Source=" & strPfad
          End With   
          With rs
              .Open "Früchteverkauf", conn, adOpenKeyset, adLockOptimistic       
              For Each Row In ActiveSheet.[2:4].Rows
                  For Each Column In ActiveSheet.[b:d].Columns
                      .AddNew
                      !Frucht = ActiveSheet.Cells(Row.Row, 1)
                      !Monat = ActiveSheet.Cells(1, Column.Column)
                      !Menge = ActiveSheet.Cells(Row.Row, Column.Column)
                      .Update
                  Next Column
              Next Row       
              .Close
          End With
          Set rs = Nothing: Set conn = Nothing    
      End Sub
      

      Pivottabelle aus Accessdatenbank erstellen

      Bearbeiten
      Sub CreatePivotTableADO()
          Dim PivotC As PivotCache
          Dim PivotT As PivotTable
          Dim strSQL$
          Dim conn As New ADODB.Connection
          Dim rs As New ADODB.Recordset   
          conn.Open "Provider=Microsoft.ace.OLEDB.12.0;" & "Data Source=" & _
              Environ("localAPPDATA") & "\microsoft\office\pivotTabelle.accdb"   
          rs.Open "Früchteverkauf", conn, adOpenKeyset, adLockOptimistic  
          If rs.RecordCount = 0 Then MsgBox ("Keine Datensätze gefunden!"), vbCritical        
          ActiveWindow.DisplayGridlines = False    
          Set PivotC = ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal)
          Set PivotC.Recordset = rs    
          Worksheets.Add Before:=Sheets(1)    
              Set PivotT = ActiveSheet.PivotTables.Add(PivotCache:=PivotC, _
                      TableDestination:=ActiveSheet.Range("a3"))        
          With PivotT
              .NullString = "0"
              .AddFields RowFields:="Frucht", ColumnFields:="Monat"
              .PivotFields("Menge").Orientation = xlDataField
          End With
          Set rs = Nothing
          Set conn = Nothing
          Set PivotT = Nothing
          Set PivotC = Nothing
      End Sub
      


      Formula Array

      Bearbeiten

      Wechseln im Menü Excel-Option/ Formeln zum S1Z1-Bezugsstil.

      Das Makro erzeugt für einen Test eine Tabellenliste. Geben Sie in die Inputboxen einen Verkäufernamen und einen Produktnamen ein. Als Ergebnis erhalten Sie zunächst eine Information, welche Gesamtmenge des Produkts der Verkäufer insgesamt veräußert hat. Darüber hinaus wird Auskunft gegeben, um wieviele Tabellenpositionen es geht. Geben Sie für einen Test den Verkäufernamen Schröder und den Produktnamen Navigation ein!

      Sub testMich()
          Dim strProdukt$
          Dim strVerkäufer
          Dim strSpalte1
          Dim strSpalte2
          Dim strSpalte3
          Dim Bereich1 As Range
          Dim Bereich2 As Range
          Dim Zelle As Range
          Dim bool As Boolean    
          With ActiveSheet
              .Cells.Clear
              .ListObjects.Add(xlSrcRange, Range("$a$1:$c$10"), , xlYes).Name = "Table1"
              .ListObjects("Table1").TableStyle = "TableStyleLight2"    
              .[a1] = "Produkt":       .[b1] = "Verkäufer":     .[c1] = "Verkaufsmenge"
              .[a2] = "Navigation":    .[b2] = "Schröder":      .[c2] = 1
              .[a3] = "Handy":         .[b3] = "Schmied":       .[c3] = 10
              .[a4] = "Navigation":    .[b4] = "Müller":        .[c4] = 20
              .[a5] = "Navigation":    .[b5] = "Schmied":       .[c5] = 30
              .[a6] = "Handy":         .[b6] = "Müller":        .[c6] = 40
              .[a7] = "iPod":          .[b7] = "Schmied":       .[c7] = 50
              .[a8] = "Navigation":    .[b8] = "Schröder":      .[c8] = 60
              .[a9] = "Handy":         .[b9] = "Becker":        .[c9] = 70
              .[a10] = "iPod":         .[b10] = "Müller":       .[c10] = 80    
              strSpalte1 = ActiveSheet.ListObjects("Table1").DataBodyRange.Columns(1).Address(False, False)
              strSpalte2 = ActiveSheet.ListObjects("Table1").DataBodyRange.Columns(2).Address(False, False)
              strSpalte3 = ActiveSheet.ListObjects("Table1").DataBodyRange.Columns(3).Address(False, False)        
              Set Bereich1 = Range(strSpalte1)
              Set Bereich2 = Range(strSpalte2)        
              strProdukt = InputBox("Gebe das Produkt ein!")
              If strProdukt = "" Then Exit Sub        
              For Each Zelle In Bereich1
                  If Zelle.Value = strProdukt Then bool = True
              Next Zelle
              If bool = False Then
                  MsgBox "Der eingegebene Produktname existiert nicht oder ist falsch", vbInformation
                  Exit Sub
              End If
              bool = False        
              strVerkäufer = InputBox("Gebe den Verkäufer ein!")
              If strVerkäufer = "" Then Exit Sub       
              For Each Zelle In Bereich2
                  If Zelle.Value = strVerkäufer Then bool = True
              Next Zelle
              If bool = False Then
                  MsgBox "Der eingegebene Verkäufername existiert nicht oder ist falsch", vbInformation
                  Exit Sub
              End If       
              .[e9] = "Gesamte Verkaufsmenge " & strProdukt & " durch Verkäufer " & strVerkäufer
              .[e10].FormulaArray = "=SUM((" & strSpalte1 & "= """ & strProdukt & """)*(" & strSpalte2 & "=""" & strVerkäufer & """)*(" & strSpalte3 & "))"        
              .[e12] = "Anzahl der Verkaufspositionen des Produkts " & strProdukt & " duch den Verkäufer " & strVerkäufer  'logischen UND letztlich aber ANZAHL der Zeilen mit Navigation von Schröder ---works---
              .[e13].FormulaArray = "=SUM((" & strSpalte1 & "= """ & strProdukt & """)*(" & strSpalte2 & " = """ & strVerkäufer & """))"       
              End With
      End Sub
      


      Bedingte Formatierung

      Bearbeiten

      Dieses Beispiel erzeugt anhand einer Beispieltabelle mit bedingter Formatierung Richtungspfeile, die abhängig vom Trend in eine bestimmte Richtung zeigen.

      Sub SetConditionalFormatting()
          Dim cfIconSet As IconSetCondition: Dim Bool As Boolean
          For Each Worksheet In ThisWorkbook.Worksheets
              If Worksheet.Name = "Bedingte Formatierung" Then Bool = True
          Next Worksheet
          If Bool = False Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Bedingte Formatierung"    
          With Sheets("Bedingte Formatierung")
              .Cells.Clear
              .Range("C1").Value = -0.01:     .Range("C6").Value = 0
              .Range("C2").Value = 0.005:     .Range("C7").Value = 0
              .Range("C3").Value = -0.02:     .Range("C8").Value = 0.005
              .Range("C4").Value = -0.02:     .Range("C9").Value = -0.02
              .Range("C5").Value = 0.005:     .Range("C10").Value = 0.005
              .Range("C1", "C10").NumberFormat = " 0.00 ;[Red] - 0.00 "   
              Set cfIconSet = .Range("C1", "C10").FormatConditions.AddIconSetCondition     
              .Range("C1", "C10").FormatConditions(1).SetFirstPriority
          End With    
          cfIconSet.IconSet = ActiveWorkbook.IconSets(xl3Arrows)
          With cfIconSet.IconCriteria(2)
              .Type = xlConditionValueNumber
              .Value = 0
              .Operator = 7
          End With   
          With cfIconSet.IconCriteria(3)
              .Type = xlConditionValueNumber
              .Value = 0.0001
              .Operator = 7
          End With  
          Set cfIconSet = Nothing
      End Sub
      

      Zellengroße Diagramme in Arbeitsblatt einfügen

      Bearbeiten

      Dieses Beispiel erzeugt anhand einiger Testdaten zellengroße Säulendiagramme.

      Sub addTinyCharts()
          Dim Bereich As Range
          Dim i As Integer    
              With ActiveSheet        
                  Set Bereich = .[b2:m4]           
                  For i = .ChartObjects.Count To 1 Step -1
                          .ChartObjects(i).Delete
                  Next i            
                  .[a1] = "Frucht":       .[B1] = "Jan.":     .[C1] = "Feb.":  .[D1] = "Mär.":    .[E1] = "Apr.":     .[f1] = "Mai": .[g1] = "Jun.": .[h1] = "Jul.": .[i1] = "Aug.": .[j1] = "Sep.": .[k1] = "Okt.": .[l1] = "Nov.": .[m1] = "Dez.": .[n1] = "Gesamt"
                  .[A2] = "Ananas":       .[B2] = 5:          .[C2] = 3:       .[D2] = 4:         .[e2] = 4:          .[f2] = 4:     .[g2] = 4:      .[h2] = 4:      .[i2] = 4:      .[j2] = 4:      .[k2] = 4:      .[l2] = 4:      .[m2] = 4
                  .[a3] = "Kiwi":         .[B3] = 45:         .[C3] = 78:      .[D3] = 78:        .[e3] = 78:         .[f3] = 98:    .[g3] = 88:      [h3] = 4:      .[i3] = 4:      .[j3] = 4:      .[k3] = 8:      .[l3] = 69:     .[m3] = 96
                  .[A4] = "Papaya":       .[B4] = 54:         .[C4] = 27:      .[D4] = 33:        .[e4] = 82:         .[f4] = 4:     .[g4] = 4:      .[h4] = 4:      .[i4] = 4:      .[j4] = 51:     .[k4] = 10:     .[l4] = 4:      .[m4] = 10
                  .[n2].Formula = "=Sum(b2:m2)"
                  .[n2].AutoFill .Range("n2:n4"), xlFillDefault
              End With    
          For Each Row In Bereich.Rows        
              ActiveSheet.Shapes.AddChart.Select       
              With ActiveChart
                  .ChartType = xlColumnClustered
                  .SetSourceData Source:=Row
                  .HasLegend = False
                  .HasTitle = False
                  .Axes(xlCategory, xlPrimary).HasTitle = False
                  .Axes(xlValue, xlPrimary).HasTitle = False
                  .HasAxis(xlCategory, xlPrimary) = False
                  .HasAxis(xlValue, xlPrimary) = False
                  .Axes(xlValue).MajorGridlines.Delete
                  .Axes(xlValue).MinorGridlines.Delete
                  .Axes(xlCategory).MajorGridlines.Delete
                  .Axes(xlCategory).MinorGridlines.Delete
                  .SeriesCollection(1).Interior.ColorIndex = 37
                  .SeriesCollection(1).Border.ColorIndex = 25
                  .Parent.Top = ActiveSheet.Cells(Row.Row, 15).Top + 1
                  .Parent.Left = ActiveSheet.Cells(Row.Row, 15).Left + 1
                  .Parent.Height = ActiveSheet.Cells(Row.Row, 15).Height - 2
                  .Parent.Width = ActiveSheet.Cells(Row.Row, 15).Width - 2
                  .Parent.Border.ColorIndex = xlNone
                  .PlotArea.Top = 0
                  .PlotArea.Left = 0
                  .PlotArea.Height = .Parent.Height
                  .PlotArea.Width = .Parent.Width
                  .ChartGroups(1).GapWidth = 50
               End With         
          Next Row
      End Sub
      


      Datensatzkollektion anlegen

      Bearbeiten

      Datensätze lassen sich in Datenfelder (Arrays) kopieren. Allerdings ist dann eine flexible Handhabung der Datensätze kaum möglich. Insofern besteht die bessere Alternative, mit Klassenmodulen zu arbeiten und Kollektionen anzulegen.

      Beachte: Kopieren Sie die letzten beiden Makros nicht in ein Standard- sondern in ein Klassenmodul. Benennen Sie die im Beispiel genannten Klassenmodule jeweils im Eigenschaftenfenster mit clsKontakt und clsKontakte.

      Folgendes Makro wäre möglich:

      Option Base 1
      Type Anwenderkontaktdaten
          LfdNr As String
          Nachname As String * 25
          HerrFrau As Boolean
          Fon As String * 25
      End Type
      
      Sub ArrayFüllen()
          Dim PersAngaben() As Anwenderkontaktdaten
          Dim i As Integer   
          [a1] = "Lfdnr": [b1] = "Nachname": [c1] = "HerrFrau": [d1] = "Fon"
          [a2] = "1":     [b2] = "Becker":   [c2] = "False":    [d2] = "123"
          [a3] = "2":     [b3] = "Becher":   [c3] = "True":     [d3] = "234"
          [a4] = "3":     [b4] = "Bäcker":   [c4] = "0":        [d4] = "456"
          For i = 2 To ActiveSheet.UsedRange.Rows.Count
              ReDim Preserve PersAngaben(i)        
              PersAngaben(i).LfdNr = Cells(i, 1)
              PersAngaben(i).Nachname = Cells(i, 2)
              PersAngaben(i).HerrFrau = Cells(i, 3)
              PersAngaben(i).Fon = Cells(i, 4)    
          Next i    
          MsgBox "Funktionstest: Im ersten Datensatz " & _
          "steht der Wert " & PersAngaben(2).LfdNr, vbInformation
      End Sub
      

      Besser ist folgende Variante:

      Standardmodul:

      option explicit
      Sub TestKontakteClass()
          Dim Kontakt As clsKontakt
          Dim Kontakte As New clsKontakte
          Dim i As Integer   
          [a1] = "Lfdnr": [b1] = "Nachname":  [c1] = "HerrFrau": [d1] = "Fon"
          [a2] = "1":     [b2] = "Becker":    [c2] = "False":    [d2] = "123"
          [a3] = "2":     [b3] = "Becher":    [c3] = "True":     [d3] = "234"
          [a4] = "3":     [b4] = "Bäcker":    [c4] = "0":        [d4] = "456"
          For i = 2 To ActiveSheet.[a1].CurrentRegion.Rows.Count
              Set Kontakt = New clsKontakt        
              Kontakt.LfdNr = ActiveSheet.Cells(i, 1)
              Kontakt.Nachname = ActiveSheet.Cells(i, 2)
              Kontakt.HerrFrau = CBool(ActiveSheet.Cells(i, 3))
              Kontakt.Fon = ActiveSheet.Cells(i, 4)        
              Kontakte.Add Kontakt
          Next i
          Kontakte.Remove 2  
          MsgBox "Nachdem der Kontakt Nr. 2 gelöscht wurde," & _
          "beträgt die Anzahl der Kontakte " & Kontakte.Count & "." & vbCr & _
          "Jetzt hat der zweite Kontakt die laufende Nummer " & Kontakte.Item(2).LfdNr & "."       
          Set Kontakte = Nothing
      End Sub
      


      Klassenmodul, Name: "clsKontakt"

      Option Explicit
      Dim pLfdNr As String
      Dim pNachname As String
      Dim pHerrFrau As Boolean
      Dim pFon As String
      Public KontaktID As String
      
      Public Property Get LfdNr() As String
          LfdNr = pLfdNr
      End Property
      
      Public Property Let LfdNr(strLfdNr As String)
          pLfdNr = strLfdNr
      End Property
      
      Public Property Get Nachname() As String
          Nachname = pNachname
      End Property
      
      Public Property Let Nachname(strNachname As String)
          pNachname = strNachname
      End Property
      
      Public Property Get HerrFrau() As Boolean
          HerrFrau = pHerrFrau
      End Property
      
      Public Property Let HerrFrau(boolHerrFrau As Boolean)
          pHerrFrau = boolHerrFrau
      End Property
      
      Public Property Get Fon() As String
          Fon = pFon
      End Property
      
      Public Property Let Fon(strFon As String)
          pFon = strFon
      End Property
      


      Klassenmodul, Name: "clsKontakte"

      Option Explicit
      Private KontakteP As Collection
      
      Public Property Get Count() As Long
          Count = KontakteP.Count
      End Property
      
      Public Function Item(Index As Variant) As clsKontakt
           Set Item = KontakteP(Index)
      End Function
      
      Public Sub Add(Kontakt As clsKontakt)
          On Error GoTo AddError
          KontakteP.Add Kontakt
          Exit Sub
      AddError:
          Err.Raise Number:=vbObjectError + 514, Source:="clsKontakte.Add", _
              Description:="Unable to Add clsKontakt object to the collection"
      End Sub
      
      Public Sub Remove(ByVal Index As Integer)
          On Error GoTo RemoveError
          KontakteP.Remove Index
          Exit Sub
      RemoveError:
          Err.Raise Number:=vbObjectError + 515, Source:="clsKontakte.Remove", _
              Description:="Das clsCell object kann nicht von der Kollektion gelöscht werden!"
      End Sub
      
      Private Sub Class_Initialize()
          Set KontakteP = New Collection
      End Sub
      
      Private Sub Class_Terminate()
          Set KontakteP = Nothing
      End Sub