PCtipp 2/2011: 10 nützliche Excel-Makros

Im PCtipp 2/2011 ab Seite 46 lesen Sie Tipps zum Umgang mit Makros inklusive zehn nützlichen Beispielen. Die müssen Sie nicht einzeln abtippen.

von Gaby Salvisberg 21.01.2011
PCtipp Top 100

Die Top-100-Produkte des Jahres im PCtipp.
Jetzt Print-Ausgabe per PayPal kaufen.

Im Februar-Heft widmen wir uns Excel und dessen vielfältigen Automatisierungsmöglichkeiten. Damit Sie die im Heft erwähnten Makros nicht abtippen müssen, kopieren Sie von hier einfach den Quellcode des gewünschten Makros. Wir empfehlen Ihnen, den erwähnten Artikel im Heft 2/2011 auf Seite 46 zu lesen, damit Sie wissen, was die Makros genau bewirken und wie Sie sie zum Beispiel in Excel 2007 der «Symbolleiste für den Schnellzugriff» zuweisen.

Makro 1: Zellwert automatisch in Fusszeile
Im Code ersetzen Sie $C$1 bzw. C1 durch die Zelle, deren Wert rechts in der Fusszeile erscheinen soll.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$1" Then
Application.EnableEvents = False
Dim Z As String
Range("C1").Select
Z = ActiveCell.Value
ActiveSheet.PageSetup.RightFooter = Z
Application.EnableEvents = True
End If
End Sub


Makro 2: Schnell Zeilen einfügen oder löschen

Code fürs erste Makro:

Sub ZeileEinfügen()
Rows(ActiveCell.Row).Insert Shift:=xlDown
End Sub

Code fürs zweite Makro:

Sub ZeileLoeschen()
Rows(ActiveCell.Row).Delete Shift:=xlUp
End Sub


Makro 3: Zeit und Datum festhalten

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveCell.Column = 1 Then
ActiveCell.Offset(-1, 1).Activate 'Falls der Cursor "normal" nach der Eingabe nach unten springt
ActiveCell.Value = Now()
ActiveCell.Offset(1, -1).Activate
End If
End Sub


Makro 4: Alle Hyperlinks entlinken

Sub hyperweg()
ActiveSheet.Cells.Hyperlinks.Delete
End Sub


Makro 5: In Zelle mit heutigem Datum springen

Private Sub Workbook_Open()
Dim Aktuell As Integer
With Worksheets("Tabelle1")
Aktuell = WorksheetFunction.Match(CDbl(Date), .Columns(1), 0)
Application.Goto .Cells(Aktuell, 1), True
End With
End Sub


Makro 6: Markierte Zellen wahlweise im Hoch- oder Querformat drucken

Code des ersten Makros für Querdruck:

Sub Quer()
ActiveSheet.PageSetup.Orientation = xlLandscape
Selection.PrintOut Copies:=1, Collate:=True
ActiveSheet.PageSetup.Orientation = xlPortrait
End Sub

Code des zweiten Makros fürs Ausdrucken im Hochformat:

Sub Hoch()
ActiveSheet.PageSetup.Orientation = xlPortrait
Selection.PrintOut Copies:=1, Collate:=True
End Sub


Makro 7: Datei unter fixem Pfad speichern
Wenn Sie das Makro ausführen, öffnet Excel den Speicherdialog und zeigt den festgelegten Speicherpfad an. Falls Sie auch immer denselben Dateinamen (oder einen Teil davon) brauchen, entfernen Sie noch das Zeichen «'» vor «datei»; allerdings nur entweder in der 6. oder 7. Zeile und in beiden Fällen auch vor «& datei» in der 10. Zeile. In der 6. Zeile nehmen Sie den Dateinamen aus einer Zelle (hier B1). Falls Sie die 7. Zeile verwenden, lautet der Dateiname immer «Huhu_ich_bin_das_File.xlsx». Das können Sie selbstverständlich beides anpassen.

Sub SpeichernUnter()
Dim dialog As Object
Dim pfad As String
Dim datei As String
pfad = "D:\Daten\Meine Excel-Files\"
'datei = ActiveSheet.Range("B1")
'datei = "Huhu_ich_bin_das_File.xlsx"
Set dialog = Application.FileDialog(msoFileDialogSaveAs)
With dialog
.InitialFileName = pfad '& datei
.Show
End With
If dialog <> False Then dialog.Execute
End Sub


Makro 8: Bestimmte Spalten schnell aus- und einblenden

Code fürs erste Makro:

Sub SpaltenAusblenden()
Sheets("Liste").Activate
Columns("A").EntireColumn.Hidden = True
Columns("E:F").EntireColumn.Hidden = True
Columns("J:M").EntireColumn.Hidden = True
End Sub

Code fürs zweite Makro:

Sub SpaltenEinblenden()
Sheets("Liste").Activate
Columns("A").EntireColumn.Hidden = False
Columns("E:F").EntireColumn.Hidden = False
Columns("J:M").EntireColumn.Hidden = False
End Sub

Code für den Umschaltknopf:

Private Sub ToggleButton1_Click()
Dim TB As ToggleButton
Set TB = ToggleButton1
If TB.Value = True Then
TB.Caption = "Spalten einblenden"
Call SpaltenAusblenden
Else
TB.Caption = "Spalten ausblenden"
Call SpaltenEinblenden
End If
End Sub


Makro 9: Dateien in Excel auflisten
Man tippe in A2 den gewünschten Ordner ein (z.B. L:\Daten\Musik\) und führt das Makro aus. Schon werden in Spalte A ab Zeile 4 die Dateien aufgelistet, die im Ordner liegen. Das erste Makro verlinkt die Dateinamen gleich mit den Files. Das zweite listet nur auf, ohne Verlinkung.

Sub DateiListeVerlinkt()
Dim strPath As String
Dim strFile As String
Dim intTMP As Integer
strPath = Range("A2").Text
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.*")
intTMP = 4 'Bedeutet: Auflisten ab 4. Zelle von oben
Do While strFile <> ""
ActiveSheet.Hyperlinks.Add _
Anchor:=Cells(intTMP, 1), _
Address:=strPath & strFile, _
TextToDisplay:=strFile
'mit "intTMP, 1" ist die erste Spalte von links gemeint (also A)
'TextToDisplay:=Left(strFile, (InStrRev(strFile, ".") - 1))
intTMP = intTMP + 1
strFile = Dir()
Loop
End Sub

Falls Sie nur die Dateinamen ohne Verlinkung wollen:

Sub DateiListe()
Dim strPath As String
Dim strFile As String
Dim intTMP As Integer
strPath = Range("A2").Text
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.*")
intTMP = 4
Do While strFile <> ""
Cells(intTMP, 1).Value = strPath & strFile
intTMP = intTMP + 1
strFile = Dir()
Loop
End Sub


Makro 10: Schnell nach Spalte C sortieren

Sub sortieren()
Sheets("Rapport").Activate
ActiveSheet.UsedRange.Select
Selection.Sort Key1:=Range("C2"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
End Sub

Die PCtipp-Ausgabe 2/2011 ist ab dem 25. Januar 2011 am Kiosk erhältlich.

Jetzt den täglichen PCtipp-Newsletter abonnieren.


    Kommentare

    • LHG 27.01.2011, 18.04 Uhr

      Hier eine Makro um eine Zeile zu kopieren (ohne zuerst eine neue Zeile einfügen zu müssen) Sub ZeileKopieren() ActiveCell.Offset(1, 0).Range("A1").Select Selection.EntireRow.Insert ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select Selection.Copy ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False End Sub

    weitere Kommentare

    Sie müssen eingeloggt sein, um Kommentare zu verfassen.