正在 VBA 中复制 Excel 源主题（仅格式化）

Question

我正在尝试以编程方式将大范围的单元格从一个工作簿复制到 VBA 中的另一个工作簿。我想复制格式（包括整个源主题）和值，但不是公式。以下是我的 VBA 代码：

fromCells.Copy

toCells.PasteSpecial Paste:=xlPasteFormats
toCells.PasteSpecial Paste:=xlPasteColumnWidths
toCells.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Application.CutCopyMode = False

不幸的是，有时上述代码不起作用。这通常与字体和大小有关。我注意到每当发生这种情况时，复制字体格式的唯一方法就是使用 xlPasteAllUsingSourceTheme，因此字体格式似乎以某种方式注册到 'source theme'。不幸的是，xlPasteAllUsingSourceTheme 对我不起作用，因为它也在复制公式。

那么有没有办法复制源主题（仅格式化）？或者也许是一种强制复制所有字体格式的方法？

注意： 使用 xlPasteAllUsingSourceTheme 复制然后用 xlPasteValues 覆盖它对我不起作用，因为当复制公式时它会不断弹出消息框告诉我有关公式的问题（例如公式中使用的命名范围冲突等）。

我使用的是 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

更新： 上面保存和加载主题的代码似乎确实有效。我看到的有问题的文本来自不同的地方——一个表单控件。它被复制为图片（使用 Shape.CopyPicture）但不知何故字体在这个过程中被改变了。但是，我会 post 这个问题作为另一个问题。

对于这个问题，我将主题保存和加载机制作为答案。

Answer 1

尝试 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

Answer 2

要强制将源主题复制到目标单元格，可以执行以下操作。不幸的是，此方法会将源主题应用于整个目标工作簿，这在我的情况下是可以的。不确定它是否对其他人有用。

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

正在 VBA 中复制 Excel 源主题（仅格式化）

Copying Excel source theme (formatting only) in VBA

excel

vba

excel-2013