Kategorie: VBA Excel

Wenn man Makros geschrieben hat, die nicht nur in einer Arbeitsmappe zur Verfügung stehen sollen, bietet Excel 2010 für PCunter Windows 7 folgenden Funktion an:

Man legt eine Datei namens PERSONAL.XLSB.

C:\Users\IhrWindowsName\AppData\Roaming\Microsoft\Excel\XLSTART

an und bringt dort seine Makros unter, die bei jedem Excel Start geladen werden sollen. Es öffnet sich dann immer gleichzeitig zwei Dateien beim öffnen von Excel: die eigentliche Datei und die PERSONAL.XLSB. (Die Datei kann auch anders genannt werden unter Excel 2010, es werden alle Excel Datein in diesem Ordner automatisch geöffnet beim Start von Excel).

In der PERSONAL.XLSB sollte der Code wie gewohnt in ein Makro gelegt werden. Wenn gewünscht wird, dass ein Makro automatisch beim Start von Excel ausgeführt wird, um z.B. eigene Menüs zur Verfügung zu stellen, kann die Methode

Private Sub Workbook_Open()

genutzt werden unter DieseArbeitsmappe.

Excel 2011 für MAC

Geht leider nicht, nur über Addins.

Addins in Excel für Mac und PC

Mit Addins lassen sich eigene Menüs einbauen in Excel, die dann auch in jeder Arbeitsmappe verfügbar sind. Diese müssen in unter „DieseArbeitsmappe“ gespeichert und die Arbeitsmappe danach neu geöffnet werden, damit der Beispiel Code ausgeführt wird.

Private Sub Workbook_Open()

Dim cbMainMenuBar As CommandBar

Dim cbcCutomMenu As CommandBarControl

On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&Mein Menupunkt").Delete
On Error GoTo 0

 Set cbMainMenuBar = _
     Application.CommandBars("Worksheet Menu Bar")

 Set cbcCutomMenu = _
     cbMainMenuBar.Controls.Add(Type:=msoControlPopup)

  cbcCutomMenu.Caption = "&Mein Menupunkt"

 With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
                .Caption = "Absätze entfernen"
                .OnAction = "AbsaetzeEntfernen"
 End With

 With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
                .Caption = "csv Dateien zusammenfügen"
                .OnAction = "csvMerge"
 End With

 With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
                .Caption = "Export einzelner .txt Dateien"
                .OnAction = "transponierenUndSpeichern"
 End With

End Sub

Bei den Betriebssystem MAC OS und Windows gibt es kleine aber feine Unterschiede, die bei der Programmierung beachtet werden müssen. Mit der folgenden Funktion kann Unterschieden werden zwischen beiden:

Function isMac() As Boolean
isMac = False
If InStr(Application.OperatingSystem, "Macintosh") Then
        isMac = True
    End If
End Function

Unterschied 1: Zeilenumbrüche entfernen

If (isMac()) Then
    zeilenumbruch = 13
Else
    zeilenumbruch = 10
End If

ActiveSheet.UsedRange.Replace Chr(zeilenumbruch), ""

Unterschied 2: Datei-Pfade

sheetName = ActiveSheet.Name
    If (isMac()) Then
        sheetPath = ActiveWorkbook.Path & ":"
    Else
        sheetPath = ActiveWorkbook.Path & "\"
    End If
    
    ActiveWorkbook.SaveAs Filename:= _
         sheetPath & sheetName & ".txt" _
        , FileFormat:=xlText, CreateBackup:=False

Bei einer Fehlermeldung wie:

Das Makro 'foo.xls!makro1' kann nicht ausgeführt werden. Das Makro ist möglicherweise in dieser Arbietsmappe nicht verfügbar, oder alle Makros wurden deaktiviert.

Sollte man erst die Sicherheitseinstellungen bezüglich Makros checken und danach überprüfen, ob das Makro auch in einem separaten Modul gespeichert ist und nicht in der Arbeitsmappe.

Vielleicht auch interessant für MS Excel Makro Spezialisten: Der Makro Speed Up Guide

Zum dynamischen Erzeugen von Diagrammen, muss man manchmal dynamischen Ranges aufbauen, wenn z.B: Zeilen ausgelassen werden sollen, weil diese einen Nullwert oder sonstiges enthalten. Dann kann mit der folgenden Funktion die XValues-Range erzeugt werden aus den zuvor bestimmten Zeilennummern:

Function getRange(ByVal spaltenBuchstabe, ByVal zeilenNummern, ByVal anzahlDaten) As String
    getRange = "="
    For i = 0 To anzahlDaten - 1
        getRange = getRange & "'SheetName'!$" & spaltenBuchstabe& "$" & zeilenNummern(i) & ":$" & spaltenBuchstabe& "$" & zeilenNummern(i)
        If Not i >= anzahlDaten - 1 Then
            getRange = getRange & ","
        End If
    Next
    rangeString = rangeString & ""
End Function

rangeDaten = getRange("B", zeilenNummern, anzahlDaten)
ActiveChart.SeriesCollection(1).Values =rangeDaten 

Ein Beispiel Skript für das Umwandeln von Excel Tabellen nach csv-Dateien:

Sub csvToExcelTabelle()
ExcSheetName = "yyy.xls"
Csvsheet = "xxx.csv"

Dim excl As Worksheet
Dim csv As Worksheet
Set csv = Workbooks(Csvsheet).Worksheets(1)
j = 1

'csv leeren
csv.Cells.Clear

For Each excl In Workbooks(ExcSheetName).Worksheets

    zeilen = excl.UsedRange.Rows.Count
    For i = 3 To zeilen
        'Zahlenformate anpassen
        excl.Cells(i, 13).NumberFormat = "m/d/yyyy"
        excl.Cells(i, 14).NumberFormat = "m/d/yyyy"
        excl.Cells(i, 2).NumberFormat = "h:mm;@"
        excl.Cells(i, 3).NumberFormat = "h:mm;@"

        csv.Cells(j, 1).Value = "D"

        csv.Cells(j, 2).Value = "NO"
        'DATEFROM
        DATEFROM = excl.Cells(i, 13).Value
        csv.Cells(j, 3).Value = DATEFROM

        'DAYOFPERIOD
        DAYOFPERIOD = ""
         For k = 1 To 7
            If (excl.Cells(i, 3 + k).Value = "x") Then
                DAYOFPERIOD = DAYOFPERIOD & k
            End If
         Next k
         csv.Cells(j, 5).Value = DAYOFPERIOD

        'SCHEDULEDTIME
        SCHEDULEDTIME = excl.Cells(i, 2).Value
        csv.Cells(j, 6).Value = Format(SCHEDULEDTIME, "h:mm;@")

        'REMOTE_ und TONAME
        REMOTE__tmp = excl.Cells(i, 1).Value
        pos = InStr(REMOTE__tmp, " (")
        If (pos <> 0) Then
            REMOTE_ = Mid(REMOTE__tmp, pos + 2, Len(REMOTE__tmp) - pos - 2)
            TONAME = Left(REMOTE__tmp, pos - 1)
        Else
            REMOTE_ = ""
            TONAME = ""
        End If
        csv.Cells(j, 7).Value = REMOTE_
        csv.Cells(j, 8).Value = TONAME

        'VIA1
        VIA1 = excl.Cells(i, 12).Value
        csv.Cells(j, 9).Value = VIA1

        j = j + 1
    Next

Next excl

End Sub