VBA - Programmierung

Neben Tricks und Tips finden Sie hier auch Programme und Add-Ins für Excel.

Euro-Rechner

Dieser Euro-Rechner besteht aus zwei Makros und kann von DM in Euro und umgekehrt umrechnen. Der Aufruf erfolgt durch zwei Schaltflächen, alle markierten Zellen werden umgerechnet.

Sub DM() ' rechnet von Euro in DM um
For Each zelle In Selection
  If zelle.Value <> "" Then zelle.Value = zelle.Value * 1.95583
Next
End Sub

Sub Euro() ' rechnet von DM in Euro um
For Each zelle In Selection
  If zelle.Value <> "" Then zelle.Value = zelle.Value / 1.95583
Next
End Sub

Speichern Sie diese beiden Makros in Ihrer persönlichen Makroarbeitsmappe (PERSONL.XLS). Der Aufruf kann entweder durch Menüeinträge oder benutzerdefinierte Icons erfolgen.
Wichtig: Die Werte in den Zellen werden ersetzt, beachten Sie dies bitte vor der Ausführung, sonst können Ihnen Daten verlorengehen.

nach oben

Quicktips für benutzerdefinierte Icons

In Excel 95 gibt es keine direkte Möglichkeit benutzerdefinierten Icons Quicktips zuzuweisen, dies ist nur über ein Makro möglich. Sie müssen nur den Namen der Symbolleiste und den Index des Icons wissen, beachten Sie aber daß die Zwischenräume mitgezählt werden müssen. Im Beispiel unten sind zwei Icons auf der Symbolleiste, die durch einen Zwischenraum getrennt sind.

Sub Quickinfo()
Toolbars("Name der Symbolleiste").ToolbarButtons(1).Name = "Datei öffnen"
Toolbars("Name der Symbolleiste").ToolbarButtons(3).Name = "Drucken"
End Sub

nach oben

Globale Suche

Wenn Sie einen Wert in verschiedenen Tabellen und Arbeitsmappen suchen wollen, ist dieses kleine Makro sehr hilfreich. Es durchsucht sämtliche Tabellenblätter in allen offenen Arbeitsmappen (mit Ausnahme der Personl.xls) nach dem eingegebenen Wert, um es einfach zu halten, habe ich keine Auswahlmöglichkeiten vorgesehen, ich will das aber bei Gelegenheit noch nachholen. Tippen sie den Makro in die Personl.xls ein oder kopieren sie es, danach müssen sie ein Icon in einer symbolleiste hinzufügen und den Makro zuweisen. Dieses Makro läuft sowohl unter Excel 95 als auch unter Excel 97.

Sub WBSearch()
Dim Result As Object, erg As Object
On Error Resume Next
thing = InputBox("Geben Sie bitte einen Wert ein :")
For b = 1 To Windows.Count
  If Windows(b).Caption = "PERSONL.XLS" Then GoTo Weiter
  Windows(b).Activate
  For a = 1 To Sheets.Count
    Sheets(a).Select
    Set erg = Cells.Find(What:=thing)
    ErsteZelle = erg.Address
    erg.Activate
gefunden:
    If Not erg Is Nothing Then
      GoOn = MsgBox("Nächsten finden ?", vbOKCancel + vbQuestion, "Weitersuchen ?")
      If GoOn = 1 Then
        Set erg = Cells.FindNext(After:=ActiveCell)
        erg.Activate
        If erg.Address = ErsteZelle Then GoTo Weiter
        GoTo gefunden
      Else
        Exit Sub
      End If
    End If
Weiter:
  Next
Next
MsgBox "Ende der Suche !", vbOKOnly + vbExclamation, "Suchergebnis"
End Sub

nach oben

Vor- und Nachname trennen

Oft kommt es vor, daß in einer Tabelle die Namen als Nachname, Vorname in einer Zelle enthalten sind. Diese zu trennen habe ich mit Birdmitteln bisher nicht geschafft (ich lasse mich gern eines besseren belehren). Die beiden benutzerdefinierten Funktionen gehen solange durch den Zellinhalt, bis sie ein bestimmtes Zeichen finden, Nachname liefert den Zellinhalt links vom Zeichen an, Vorname den Zellinhalt rechts vom Zeichen. Die Namen sind frei gewählt, natürlich lassen sich auch andere Inhalten trennen. Als Parameter müssen der Name, dies ist der Zellinhalt, der getrennt werden soll und Trennzeichen, das Zeichen, bei dem getrennt werden soll (z.B. "," ,"a", " ") übergeben werden. Evtl. Leerzeichen werden abgeschnitten, so daß hier keine zusätzliche Funktion nötig ist. Sobald die Formeln in die PERSONL.XLS eingefügt sind, stehen sie im Formeleditor als benutzerdefinierte Formeln zur Verfügung.

Function Nachname(Name, Zeichen)
For a = 1 To Len(Name)
  If Right(Left(Name, a), 1) = Zeichen Then
    Nachname = Trim(Left(Name, a - 1))
    Exit For
  End If
Next
End Function

Function Vorname(Name, Zeichen)
For a = Len(Name) To 1 Step -1
  If Left(Right(Name, a), 1) = Zeichen Then
    Vorname = Trim(Right(Name, a - 1))
    Exit For
  End If
Next
End Function

Ein Beispiel, die Zelle A1 enthält Müller, Fritz. Für die Parameter Name = "A1" und Zeichen = "," liefert Nachname "Müller". Vorname liefert für dieselben Parameter " Fritz", um das Leerzeichen zu vermeiden, muß als Parameter Zeichen = " " angegeben werden.

nach oben

Die Menüleiste mit eigenen Menüs erweitern

In Excel 95 können Sie die integrierte Menüleiste sehr leicht über den Menüeditor bearbeiten, den Sie im Menü Extras finden, sobald Sie sich in einem Modul befinden. Hier können Sie eigene Menüs hinzufügen und den Sub definieren der ausgeführt werden soll oder Menüs löschen.
Nicht mehr so komfortabel ist die Menübearbeitung in Excel 97. Der Menüeditor ist nicht mehr vorhanden, Sie müssen die Menüs über ein Makro definieren. Das folgende Makro zeigt Ihnen ein Beispiel:

Sub Auto_Open()
Set ML = Application.CommandBars("Worksheet Menu Bar")
' Name für neues Menü wird gesetzt
Set U1 = ML.Controls.Add(Type:=msoControlPopup, Before:=10)
U1.Caption = "&Mein Menü"
U1.Tag = "MeinMenü" ' dient zur eindeutigen Identifizierung des Menüs

' 1. Menüpunkt wird angelegt
Set Punkt = U1.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&1. Menüpunkt"
.OnAction = "Makro1"
.Style = msoButtonIconAndCaption
.FaceId = 2103
End With

' neues Untermenü wird hinzugefügt
Set Punkt = U1.Controls.Add(Type:=msoControlPopup)
With Punkt
.Caption = "1.Untermenü"
End With

Set U2 = Punkt ' Variable für das 2. Untermenü wird gesetzt
'Neuer Menüeintrag im 2.Untermenü
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&2.Menüpunkt"
.OnAction = "Makro2"
.Style = msoButtonIconAndCaption
.FaceId = 144
End With

Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&3.Menüpunkt"
.OnAction = "Makro3"
.Style = msoButtonIconAndCaption
.FaceId = 1715
End With

' Weiterer Eintrag im 1.Untermenü
Set Punkt = U1.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&4.Menüeintrag"
.OnAction = "Makro4"
.Style = msoButtonIconAndCaption
.FaceId = 3200
End With
End Sub

Dieses Makro erzeugt das nebenstehende Menü, zuerst wird ein Popup-Menü in die Standard-Menüleiste eingefügt und ihm der Namen Mein Menü zugewiesen. Es ist wichtig, das Sie diesen Menüpunkt als Variable (hier U1) setzen, da sie das Untermenü sonst nur über den Namen ansprechen können. Leider ändern sich diese von Zeit zu Zeit, so daß sie nicht direkt angesprochen werden können (z.B. Untermenü 5).. Im nächsten Schritt fügen Sie dem Untermenü (U1) einen neuen Menüeintrag (Punkt) hinzu und weisen ihm die entsprechenden Eigenschaften zu. Als nächstes fügen Sie ein Untermenü in Form eines Popup-Menüs ein, diesem weisen Sie den Namen U2 zu. Diesem Untermenü fügen Sie dann wie oben beschrieben Unterpunkte hinzu. Wollen Sie weitere Einträge im Untermenü 1 (U1) hinzufügen, ersetzen Sie U2 einfach wieder durch U1. Wollen Sie Weitere Untermenüs einfügen nummerieren Sie diese einfach durch.

Um das Menü wieder zu löschen reichen folgende Anweisungen:

Sub Auto_Close
Set ML = Application.CommandBars("Worksheet Menu Bar")
On Error Resume Next ' Fehlerbehandlung
ML.FindControl(Tag:="MeinMenü").Delete
End Sub

Die Fehlerbehandlung dient dazu, einen Laufzeitfehler abzufangen, falls das Menü nicht existiert.

nach oben

Benutzernammen ermitteln

Gelegentlich kommt es vor, daß der Benutzername ermittelt werden muß, dazu gibt es 2 Möglichkeiten:

1. Abfrage mit Hilfe einer API-Funktion:
Declare Function GetUsername Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function User()
Dim Buffer As String * 100
Dim BuffLen As Long
Dim Username As String
BuffLen = 100
GetUsername Buffer, BuffLen
User = Left(Buffer, BuffLen - 1)
End Function

2. Abfrage über die Environ-Funktion:
Function User()
User = Environ("Username")
End Function

Welche der beiden Funktionen die bessere ist läßt sich nicht ohne weiteres sagen, dies hängt vom anwendungszweck und vom Betriebssystem ab.

nach oben

Fax verschicken

Wer Faxe über die eingebaute Fax-Funktion von Windows verschickt, hat sich bestimmt schon oft geärgert, daß jedesmal der Drucker umgestellt werden muß. Ein einfaches Makro schafft hier Abhilfe:

Sub Fax()
Drucker = ActivePrinter
ActivePrinter = "Fax"
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
Collate:=True, Background:=True, PrintToFile:=False
ActivePrinter = Drucker
End Sub

In Excel lautet die Anweisung:

Sub Fax()
Drucker = ActivePrinter
ActivePrinter = "Fax"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActivePrinter = Drucker
End Sub

Dabei wird der aktuelle Drucker gespeichert, dann das Fax (hier müsssen sie den Namen des Faxes auf ihrem Computer angeben) als Drucker aktiviert. Danach wird eine Datei abgeschickt (die Faxnummer usw. muß weiterhin manuell angegeben werden) und der ursprüngliche Drucker wieder aktiviert.

nach oben

Alles speichern

Frontpage 2000 bietet keine Funktion alle geänderten Dateien zu speichern, so daß jede Datei einzeln gespeichert werden muß. Das folgende Makro speichert alle offenen Dateien eines Webs ohne jede weitere Nachfrage ab. Der Aufruf erfolgt am besten über eine benutzerdefinierte Schaltfläche, der dieses Makro zugewiesen wird.

Sub AlleSpeichern()
For Each Datei In ActiveWebWindow.PageWindows
  Datei.Save
Next
End Sub

Aus mir unbekannten Gründen erscheint manchmal ein Laufzeitfehler,so daß das Speichern nicht möglich ist. Dann einfach nochmal versuchen oder eben doch von Hand speichern.

nach oben

Mehr zu Excel finden Sie im Downloadbereich, hier können Sie Add-Ins und kleine Programme herunterladen. Entweder Sind die Programme selbsterklärend oder es ist eine Kurzanleitung dabei. Sollten Sie Probleme oder Verbesserungsvorschläge haben, würde ich mich freuen, wenn Sie mir dies mitteilen würden.