Question

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

fromCells.Copy

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

Application.CutCopyMode = False

不幸的是，有时上述代码不起作用。这通常是字体的面部和大小。我注意到，只要发生这种情况，复制字体格式的唯一方法是使用xlPasteAllUsingSourceTheme，因此字体格式似乎以某种方式注册到源主题＆＃39;。遗憾的是，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），但不知何故，字体在此过程中发生了变化。但是，我会将此问题作为另一个问题发布。

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

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源主题（仅格式化）

2 个答案: