I have a question about Excel VBA. I struggle to find out what is causing a certain behaviour.
When running the code below, which is started with a Button on sheet 1, the graphs on sheet 2 are changed.
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
The Y-axis of the graphs, gives values that are divided by 1000, instead of the original values. Even when changing the variables (for example max and min in the settings) within Excel, the fault is still happening. The only way to fix it, is the re-start the workbook. This fault is visible when exporting to PDF and printing. Also with different laptops and office 365/2021.
Example:
Does anybody has an idea what could cause this?
Thanks!
BR Stijn
I have googled and searched multiple message boards, but I'm out of ideas.
