Question

我正在编写一个宏，它确实将特定的工作表从主工作簿复制到新创建的工作表。发生的问题是，新的工作表中的格式设置有误。例如：如果第一张工作表（主工作簿）中的A1的值为“无错误”，并且字体颜色设置为绿色，则在新创建的工作簿的工作表中，字体颜色为橙色。某些单元格背景也会发生这种情况，这些背景是手动设置格式的（不是有条件的）。如果单元格A2确实包含“错误”，并且字体和背景色设置为红色（基于条件格式），则将格式正确复制到新工作簿中。循环遍历所有颜色错误的列是不可行的。

我尝试过的事情：

PasteSpecial（格式），
使用vba将新工作簿的Color主题设置为旧主题（无法正常工作）

发现：

仅在将工作表复制到新工作簿时出现错误的颜色
我已经阅读到，由于新工作簿中的颜色模板不同，可能会发生此错误，但是我无法更改主题
ws.Copy After:=wbFile.Worksheets(1)行的格式有误，因此基于其他Subs的格式依赖项不会导致错误的着色

我非常感谢任何帮助或指导。谢谢。

Public Sub saveKonsoData()
Dim strDir As String
Dim wbFile As Workbook
Dim File As String
Dim ws As Worksheet

On Error GoTo fehler

Application.ScreenUpdating = False

strDir = ThisWorkbook.Path & "\XYZ"
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    End If

Set wbFile = Workbooks.Add

Set ws = ThisWorkbook.Worksheets(konsoName) 'konsoName is a string Constant

ws.Copy After:=wbFile.Worksheets(1)


File = ThisWorkbook.Path & "\XYZ\" & Format(Now, "YYYY.MM.dd hh.mm") & "_" & "NEWWORKBOOK" & ".xlsx"
Application.DisplayAlerts = False


wbFile.SaveAs File
wbFile.Close

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "Die Speicherung war erfolgreich.", vbInformation + vbOKOnly
Exit Sub

fehler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Die Speicherung der konsolidierten Datei war nicht erfolgreich. Bitte speichern Sie die Datei manuell.", vbInformation + vbOKOnly
End Sub

编辑：

我偶然发现了使用 xlPasteAllUsingSourceTheme 的可能性。我复制了单元格而不是工作表，并使用了上述常量。这解决了问题。可以在下面看到已更改的代码片段。

Set ws = ThisWorkbook.Worksheets(konsoName)

'ws.Copy After:=wbFile.Worksheets(1)
''TEST STARTS
ws.Cells.Copy

wbFile.Worksheets(1).Cells.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, _ 
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
''TEST ENDs

复制工作表后颜色错误

0 个答案: