执行Save As后Excel图表Y轴数值异常(被除以1000)求助
Excel VBA宏运行后图表Y轴数值异常问题
运行Sheet1按钮触发的SaveReport宏后,Sheet2中图表的Y轴数值变为原数值的1/1000。手动修改Excel内的轴范围等设置无法解决该问题,仅重启工作簿可恢复正常。此异常在导出PDF、打印时均可见,且在不同电脑、Office 365/2021版本中均会出现。
宏代码
Public Sub SaveReport() Dim generaldirectory As String Dim yearDirectory As String Dim projectNumberDirectory As String Dim fileName As String Dim projectNumber As String Dim CertificateNumber As String CertificateNumber = ActiveWorkbook.Worksheets("Report").range("F10") If CertificateNumber = "" Then MsgBox "Het kalibratierapport kan niet opgeslagen worden zonder een certificaatnummer.", vbQuestion Else 'Find projectnumber Dim regex As RegExp Set regex = New RegExp Dim Str As String With regex .Pattern = "E[BNS]{1}[0-9]{2}[BN]?-[0-9]+" End With Set matches = regex.Execute(CertificateNumber) For Each Match In matches projectNumber = Match.value Next Match If (projectNumber = "") Then MsgBox "Vul een projectnummer in dat voldoet aan de vereisten van ENMO.", vbExclamation Else If ReportIsAlreadySaved Then 'Save File Call addLogInHistory("Save of the calibration report", "/", False) ActiveWorkbook.save Else 'Structure directory generaldirectory = "\\AD2016\ENMO Services\Rapporten Service\" yearDirectory = Year(Now) & "\" projectNumberDirectory = projectNumber & "\" fileName = CertificateNumber & " _ rapp-cert" totalDirectory = generaldirectory & yearDirectory & projectNumberDirectory & fileName 'Master file is not new, openened a saved file If ActiveWorkbook.Worksheets("_Data").range("E4") <> "" Then Dim answer As Integer Dim modNumber As Integer Dim modification As String Dim modificationReason As String Dim modificationExecuter As String answer = MsgBox("Wil je een modificatie van het vorige certificaat? ", vbYesNo + vbQuestion) If answer = vbYes Then ActiveWorkbook.Worksheets("_Data").range("E5") = ActiveWorkbook.Worksheets("_Data").range("E5") + 1 modNumber = ActiveWorkbook.Worksheets("_Data").range("E5") fileName = ActiveWorkbook.Worksheets("_Data").range("E4") & " _ MOD" & modNumber & " _ rapp-cert" totalDirectory = generaldirectory & yearDirectory & projectNumberDirectory & fileName 'Change title property (visible in PDF) ActiveWorkbook.BuiltinDocumentProperties("Title") = ActiveWorkbook.Worksheets("_Data").range("E4") & " _ MOD" & modNumber 'Backup Original, it will be lost Dim backup As String backup = ActiveWorkbook.Worksheets("_Data").range("E4") 'Change certificateNumber ActiveWorkbook.Worksheets("Report").range("F10") = ActiveWorkbook.Worksheets("_Data").range("E4") & " _ MOD" & modNumber 'Use backup ActiveWorkbook.Worksheets("_Data").range("E4") = backup 'Reden van de modificatie modification = InputBox("Wat is er aangepast in het certificaat?") modificationReason = InputBox("Geef de reden van de modificatie?") modificationExecuter = InputBox("Geef de uitvoerder van de modificatie?") ActiveWorkbook.Worksheets("Result").range("B9") = ActiveWorkbook.Worksheets("Result").range("B9") & vbCrLf & "MOD" & modNumber & ", modification of original certificate '" & ActiveWorkbook.Worksheets("_Data").range("E4") & "'" & vbCrLf & " -> Adaptation: " & modification & vbCrLf & " -> Reason: " & modificationReason & vbCrLf & " -> Executer: " & modificationExecuter ReportIsAlreadySaved = True 'Save total directory ActiveWorkbook.Worksheets("_Data").range("E6") = totalDirectory Call addLogInHistory("Modification of calibration report created", "MOD" & modNumber & " - " & modification & " - " & modificationReason, False) Call addLogInHistory("Save of the calibration report after modification", "MOD" & modNumber, False) 'Save as File ActiveWorkbook.SaveAs fileName:= _ totalDirectory & ".xlsm", _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False Else 'Eenmalige 'save as' bij heropenen van bestand, om zo te kunnen hergebruiken voor een andere kalibratie, kan niet meer 'LET OP: er moet altijd van een nieuwe master begonnen worden 'Save File Call addLogInHistory("Save of the calibration report after re-opening the report", "/", False) ActiveWorkbook.save ReportIsAlreadySaved = True End If Else Dim strFolderExists As String 'Create year directory if necessary (only once a year) strFolderExists = dir(generaldirectory & yearDirectory, vbDirectory) If strFolderExists = "" Then MkDir generaldirectory & yearDirectory End If 'Create project directory if necessary strFolderExists = dir(generaldirectory & yearDirectory & projectNumberDirectory, vbDirectory) If strFolderExists = "" Then MkDir generaldirectory & yearDirectory & projectNumberDirectory End If 'Change title property (visible in PDF) ActiveWorkbook.BuiltinDocumentProperties("Title") = CertificateNumber 'Save Original Certificate Number ActiveWorkbook.Worksheets("_Data").range("E4") = CertificateNumber 'Save total directory ActiveWorkbook.Worksheets("_Data").range("E6") = totalDirectory 'Fix calibration date ActiveWorkbook.Worksheets("Report").range("F12") = Date Call addLogInHistory("Initial save of the calibration report", CertificateNumber, False) 'Save as File ActiveWorkbook.SaveAs fileName:= _ totalDirectory & ".xlsm", _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False ReportIsAlreadySaved = True End If End If End If End If End Sub
异常示例图

已查阅谷歌及多个论坛,未找到问题原因,恳请帮忙分析可能的诱因。
内容的提问来源于stack exchange,提问作者Stijn
相关产品推荐
相关产品推荐

