在VBA中复制Excel源主题（仅格式）
我试图以编程方式将大范围的单元格从一个工作簿复制到另一个VBA中。 我想复制格式（包括整个源主题）和值，但不是公式。 以下是我的VBA代码：
fromCells.Copy toCells.PasteSpecial Paste:=xlPasteFormats toCells.PasteSpecial Paste:=xlPasteColumnWidths toCells.PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False 不幸的是，上面的代码有时候不起作用。 这通常是与字体的脸部和大小。 我注意到，每当发生这种情况时，复制字体格式的唯一方法是使用xlPasteAllUsingSourceTheme ，所以看起来字体格式是以某种方式注册到“源主题”。 不幸的是， xlPasteAllUsingSourceTheme不适用于我，因为它也在复制公式。
那么有没有办法复制源主题（仅格式）？ 或者也许强制复制所有字体格式的方法？
注意：使用xlPasteAllUsingSourceTheme复制，然后用xlPasteAllUsingSourceTheme覆盖它将xlPasteValues用于我，因为当公式被复制时，popup消息框会告诉我有关公式的问题（例如公式中使用的冲突命名范围等） 。
我正在使用Excel 2013.我注意到这个问题似乎没有出现在Excel 2007或更早版本中。 任何帮助表示赞赏。
编辑：我也试过下面的代码（添加到上面的代码的开头），它仍然不工作…
Dim themeTempFilePath As String themeTempFilePath = Environ("temp") & "\" & fromWorkbook.Name & "Theme.xml" fromWorkbook.Theme.ThemeFontScheme.Save themeTempFilePath toWorkbook.Theme.ThemeFontScheme.Load themeTempFilePath fromWorkbook.Theme.ThemeColorScheme.Save themeTempFilePath toWorkbook.Theme.ThemeColorScheme.Load themeTempFilePath
更新：似乎上面的代码保存和加载主题确实工作。 我所看到的有问题的文本来自不同的地方 – 一种forms控制。 它被复制为一张图片（使用Shape.CopyPicture ），但不知何故字体在这个过程中被改变。 不过，我将这个问题作为另一个问题发布。
对于这个问题，我会把主题保存和加载机制作为答案。
尝试1或2
Option Explicit Public Sub copyWithoutFormulas_1() xlEnabled False With Sheet2 .EnableCalculation = False .EnableFormatConditionsCalculation = False .UsedRange.EntireColumn.Delete Sheet1.UsedRange.Copy .Cells(1, 1) .UsedRange.Value2 = .UsedRange.Value2 .EnableCalculation = True .EnableFormatConditionsCalculation = True End With Application.CutCopyMode = False xlEnabled True End Sub Public Sub copyWithoutFormulas_2() xlEnabled False Sheet1.Copy After:=Worksheets(Worksheets.Count) With Worksheets(Worksheets.Count).UsedRange .Value2 = .Value2 End With xlEnabled True End Sub Private Sub xlEnabled(ByVal opt As Boolean) With Application .EnableEvents = opt .DisplayAlerts = opt .ScreenUpdating = opt .Calculation = IIf(opt, xlCalculationAutomatic, xlCalculationManual) End With End Sub
要强制将源主题复制到目标单元格，可以执行以下操作。 不幸的是，这种方法会将源主题应用到整个目标工作簿，这在我的情况下是可以的。 不知道是否对其他人有用。
Sub CopyText(fromCells As Range, toCells As Range, Optional copyTheme As Boolean = False) If copyTheme Then Dim fromWorkbook As Workbook Dim toWorkbook As Workbook Dim themeTempFilePath As String Set fromWorkbook = fromCells.Worksheet.Parent Set toWorkbook = toCells.Worksheet.Parent themeTempFilePath = Environ("temp") & "\" & fromWorkbook.Name & "Theme.xml" fromWorkbook.Theme.ThemeFontScheme.Save themeTempFilePath toWorkbook.Theme.ThemeFontScheme.Load themeTempFilePath fromWorkbook.Theme.ThemeColorScheme.Save themeTempFilePath toWorkbook.Theme.ThemeColorScheme.Load themeTempFilePath End If Set toCells = toCells.Cells(1, 1).Resize(fromCells.Rows.Count, fromCells.Columns.Count) fromCells.Copy toCells.PasteSpecial Paste:=xlPasteFormats toCells.PasteSpecial Paste:=xlPasteColumnWidths toCells.PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False End Sub