更改多个工作簿中的字体(Microsoft Excel)
Hamish面临着艰巨的任务:他需要更改大量Excel工作簿中使用的默认字体。他有100多个工作簿,这些工作簿中使用的字体需要更改为公司授权指定的新字体。 (您知道公司的职责是如何!)
解决此任务的手动方法是加载每个工作簿,浏览每个工作表,选择单元格并更改这些单元格中的字体。为了使Hamish的任务更加复杂,他需要在每个工作簿中更改多种字体。换句话说,给定字体A,B,C和D,Hamish需要将字体A更改为C,将字体B更改为D。
解决此问题的最佳方法是使用宏。
太多的加载,搜索和更改都是必需的,因此只有将工作委托给宏才有意义。下面的宏可以完成这项工作:
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
要将宏与您自己的工作簿一起使用,您需要做几件事。首先,确保要更改的所有工作簿都存储在一个文件夹中,并且知道该文件夹的名称。然后,在宏中,更改在宏开头附近定义的变量。更改vNamesFind和vNamesReplace数组的元素以匹配要分别查找和替换的字体的名称。然后,您应该更改sPath变量,使其包含包含您的工作簿的文件夹的完整路径。
(不要忘记路径上的尾部反斜杠。)
当您运行宏时,它将依次加载文件夹中的每个工作簿。
然后,它遍历每个工作簿中的每个工作表,并检查每个单元格。如果单元格具有要找到的字体之一,则将其替换为相应的替换字体。使用工作簿完成宏后,将保存该宏并处理下一个工作簿。
那些有兴趣避免在新工作表上出现此类问题的人应该探索如何在Excel中使用样式。您可以定义任意多种样式,并在整个工作簿中使用它们。如果以后需要更改特定单元格的格式,则只需更改基础样式即可。 (样式已在_ExcelTips的其他问题中讨论过。)
注意:
如果您想知道如何使用此页面(或_ExcelTips_网站上的任何其他页面)中描述的宏,我准备了一个特殊页面,其中包含有用的信息。
链接:/ excelribbon-ExcelTipsMacros [点击此处在新的浏览器标签中打开该特殊页面]。
_ExcelTips_是您进行经济高效的Microsoft Excel培训的来源。
本技巧(2526)适用于Microsoft Excel 97、2000、2002和2003。可以在以下功能区中为Excel的功能区界面(Excel 2007及更高版本)找到本技巧的版本:
链接:/ excelribbon-Changing_Fonts_in_Multiple_Workbooks [更改多个工作簿中的字体]。