Hamish steht vor einer entmutigenden Aufgabe: Er muss die Standardschriftarten ändern, die in einer großen Anzahl von Excel-Arbeitsmappen verwendet werden. Er verfügt über mehr als 100 Arbeitsmappen, und die in diesen Arbeitsmappen verwendeten Schriftarten müssen in eine neue Schriftart geändert werden, die vom Unternehmensmandat festgelegt wird. (Sie wissen, wie Unternehmensmandate sein können!)

Die manuelle Vorgehensweise für diese Aufgabe besteht darin, jede Arbeitsmappe zu laden, jedes Arbeitsblatt durchzugehen, die Zellen auszuwählen und die Schriftarten in diesen Zellen zu ändern. Um Hamishs Aufgabe noch komplexer zu gestalten, muss er mehrere Schriftarten in jeder Arbeitsmappe ändern. Mit anderen Worten, bei gegebenen Schriftarten A, B, C und D muss Hamish die Schriftart A in C und die Schriftart B in D ändern.

Der beste Weg, um dieses Problem anzugehen, ist die Verwendung eines Makros.

Es wird so viel geladen, gesucht und geändert, dass es nur sinnvoll ist, die Arbeit in ein Makro zu verwandeln. Das folgende Makro sollte den Job erledigen:

Sub ChangeFontNames()

Dim vNamesFind     Dim vNamesReplace     Dim sFileName As String     Dim Wkb As Workbook     Dim Wks As Worksheet     Dim rCell As Range     Dim x As Integer     Dim iFonts As Integer     Dim sPath As String

'Change these lines as appropriate     'These are the fontnames to find     vNamesFind = Array("Arial", "Allegro BT")

'These are the fontnames to replace     vNamesReplace = Array("Wingdings", "Times New Roman")

'This is the folder to look for xls files     sPath = "C:\foldername\"



Application.ScreenUpdating = False     iFonts = UBound(vNamesFind)

If iFonts <> UBound(vNamesReplace) Then         MsgBox "Find and Replace Arrays must be the same size"

Exit Sub     End If     sFileName = Dir(sPath & "*.xls")

Do While sFileName <> ""

Set Wkb = Workbooks.Open(sPath & sFileName)

For Each Wks In Wkb.Worksheets             For Each rCell In Wks.UsedRange                 For x = 0 To iFonts                     With rCell.Font                         If .Name = vNamesFind(x) Then _                             .Name = vNamesReplace(x)

End With                 Next             Next         Next         Wkb.Close(True)

sFileName = Dir     Loop     Application.ScreenUpdating = True     Set rCell = Nothing     Set Wks = Nothing     Set Wkb = Nothing End Sub

Um das Makro mit Ihren eigenen Arbeitsmappen zu verwenden, müssen Sie einige Dinge tun. Stellen Sie zunächst sicher, dass alle Arbeitsmappen, die Sie ändern möchten, in einem einzigen Ordner gespeichert sind und dass Sie den Namen des Ordners kennen. Ändern Sie dann innerhalb des Makros die Variablen, die am Anfang des Makros definiert sind. Ändern Sie die Elemente der Arrays vNamesFind und vNamesReplace so, dass sie mit den Namen der Schriftarten übereinstimmen, die Sie suchen bzw. ersetzen möchten. Sie sollten dann die Variable sPath so ändern, dass sie den vollständigen Pfad zu dem Ordner enthält, der Ihre Arbeitsmappen enthält.

(Vergessen Sie nicht einen nachgestellten Backslash auf dem Pfad.)

Wenn Sie das Makro ausführen, wird nacheinander jede Arbeitsmappe in den Ordner geladen.

Dann geht es jedes Arbeitsblatt in jeder Arbeitsmappe durch und untersucht jede Zelle. Wenn in der Zelle eine der zu findenden Schriftarten vorhanden ist, wird diese durch die entsprechende Ersatzschrift ersetzt. Wenn das Makro mit der Arbeitsmappe fertig ist, wird es gespeichert und die nächste Arbeitsmappe verarbeitet.

Diejenigen, die diese Art von Problem in neuen Arbeitsblättern vermeiden möchten, sollten sich mit der Verwendung von Stilen in Excel befassen. Sie können beliebig viele Stile definieren und in einer Arbeitsmappe verwenden. Wenn Sie später die Formatierung für bestimmte Zellen ändern müssen, müssen Sie lediglich die zugrunde liegenden Stile ändern. (Stile wurden in anderen Ausgaben von ExcelTips. behandelt.)

_Hinweis: _

Wenn Sie wissen möchten, wie die auf dieser Seite (oder auf einer anderen Seite der ExcelTips-Websites) beschriebenen Makros verwendet werden, habe ich eine spezielle Seite vorbereitet, die hilfreiche Informationen enthält.

ExcelTips ist Ihre Quelle für kostengünstige Microsoft Excel-Schulungen.

Dieser Tipp (564) gilt für Microsoft Excel 2007, 2010, 2013, 2016, 2019 und Excel in Office 365. Eine Version dieses Tipps für die ältere Menüoberfläche von Excel finden Sie hier: