You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

执行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

异常示例图

图表Y轴数值异常示例

已查阅谷歌及多个论坛,未找到问题原因,恳请帮忙分析可能的诱因。

内容的提问来源于stack exchange,提问作者Stijn

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.06.14 00:05:53