AW: Zellen / Zeilen per VBA formatieren?
11.02.2007 10:17:52
fcs
Hallo Selma,
nachfolgend Makros, die sytematisch die Formarierung durchführen.
Lege eine neue Exceldatei an und öffne den VBA-Editor.
Im VBA-Editor fügst du ein Modul ein und kopierst den Code der Makros in das Editor-Fenster des Moduls.
Datei speichern und Makro-Starten.
Im angezeigten Datei-Auswahlkatalog kannst du eine oder mehrere Dateien auswählen.
Beim Speichern der formatierten Dateien werden die Original-Dateien überschrieben. Falls das nicht gewünscht ist, dann vor der Aktion die zu formatierenden Dateien in ein separates Verzeichnis kopieren.
Gruss
Franz
Sub Formatierung()
'Systematische Formatierung von Zellen in gewählten Dateien
Dim wb As Workbook, wks As Worksheet, Zeile As Long, ZeileL As Long, Spalte As Integer
Dim strWb, j As Integer, i As Integer
Do
'Arbeitsmappe(n) auswählen, die formatiert werden sollen, _
Mehrfachauswahl im Dialog ist möglich
strWb = Application.GetOpenFilename(Filefilter:="Excel (*.xls), *.xls", _
Title:="Bitte Datei(en) für Formatierung auswählen, Abbrechen beendet das Makro", _
MultiSelect:=True)
If Not IsArray(strWb) Then Exit Sub 'Abbrechen wurde im Dialog gewählt
'Gewälte Dateien abarbeiten
For j = LBound(strWb) To UBound(strWb)
Set wb = Workbooks.Open(Filename:=strWb(j))
Application.ScreenUpdating = False
'Alle Blätter der Arbeitsmappe formatieren
For i = 1 To wb.Worksheets.Count 'to auf 1 setzen wenn immer nur das 1. Blatt formatiert werden soll
Set wks = wb.Worksheets(i)
With wks
Zeile = 1
ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row 'Letzte Zeile mit Daten
Do
'Zeile mit "$TYP:" suchen
Do Until .Cells(Zeile, 1).Value = "$TYP:"
If Zeile > ZeileL Then GoTo NextBlatt
Zeile = Zeile + 1
Loop
'Typ-Zellen formatieren
.Range(.Cells(Zeile, 1), .Cells(Zeile, 2)).Font.Bold = True
Call RahmenFarbe(.Range(.Cells(Zeile, 1), .Cells(Zeile, 2)), 45, xlContinuous, xlHairline)
'Überschrift-Zeile formatieren
Zeile = Zeile + 1
Spalte = .Cells(Zeile, .Columns.Count).End(xlToLeft).Column 'Letzte Spalte in Überschriftzeile
.Range(.Cells(Zeile, 1), .Cells(Zeile, Spalte)).Font.Bold = True
Call RahmenFarbe(.Range(.Cells(Zeile, 1), .Cells(Zeile, Spalte)), 15, xlContinuous, xlHairline)
'Daten-Zeilen formatieren
Do Until IsEmpty(.Cells(Zeile + 1, 1))
If Zeile > ZeileL Then GoTo NextBlatt
Zeile = Zeile + 1
.Cells(Zeile, 1).Font.Bold = True
Call RahmenFarbe(.Range(.Cells(Zeile, 1), .Cells(Zeile, Spalte)), 35, xlContinuous, xlHairline)
Loop
Loop
End With
NextBlatt:
Next i
Application.ScreenUpdating = True
'Datei speichern und schließen
wb.Save
wb.Close
Next j
Loop
End Sub
Sub RahmenFarbe(Bereich As Range, Farbe, LinieStil, LinieBreite)
'Farbe und Linien des Zellbereichs formatieren
With Bereich
.Interior.colorindex = Farbe
.BorderAround LineStyle:=LinieStil, Weight:=LinieBreite
With .Borders(xlInsideVertical)
.LineStyle = LinieStil
.Weight = LinieBreite
End With
End With
End Sub