From df618ca588539be70d8ba108ce8710f342a17c3b Mon Sep 17 00:00:00 2001 From: magdev Date: Fri, 19 Jul 2024 02:01:29 +0200 Subject: [PATCH] Image-Handler, Technical Reporting and Sourcefile exports Started to implement image handling for technical reports. Not sure if heading in the right direction. Added page 2 for technical reports. Export VBA code to sourcefiles for better git handling --- cockpit.xlsm | 4 +- src/BaseModule.bas | 85 ++++++++++++++ src/DieseArbeitsmappe.cls | 33 ++++++ src/ImageHandler.bas | 100 +++++++++++++++++ src/LayoutHandler.bas | 33 ++++++ src/RootdataPage.bas | 228 ++++++++++++++++++++++++++++++++++++++ src/Tabelle1.cls | 11 ++ src/Tabelle2.cls | 11 ++ src/Tabelle3.cls | 11 ++ src/Tabelle4.cls | 11 ++ src/Tabelle5.cls | 11 ++ src/Tabelle6.cls | 11 ++ 12 files changed, 547 insertions(+), 2 deletions(-) create mode 100644 src/BaseModule.bas create mode 100644 src/DieseArbeitsmappe.cls create mode 100644 src/ImageHandler.bas create mode 100644 src/LayoutHandler.bas create mode 100644 src/RootdataPage.bas create mode 100644 src/Tabelle1.cls create mode 100644 src/Tabelle2.cls create mode 100644 src/Tabelle3.cls create mode 100644 src/Tabelle4.cls create mode 100644 src/Tabelle5.cls create mode 100644 src/Tabelle6.cls diff --git a/cockpit.xlsm b/cockpit.xlsm index c06d884..44e8b0a 100644 --- a/cockpit.xlsm +++ b/cockpit.xlsm @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:517d4aeed2cbc5c165faa57463ff7c6dddeb1871a5f5a12da51d9c72f8352d25 -size 139653 +oid sha256:0ce4f640db34d59d10899a0a8a197d507607d2e664ba38c9ef0ff8eea75751c2 +size 141319 diff --git a/src/BaseModule.bas b/src/BaseModule.bas new file mode 100644 index 0000000..3838784 --- /dev/null +++ b/src/BaseModule.bas @@ -0,0 +1,85 @@ +Attribute VB_Name = "BaseModule" +Option Explicit +' +' Base-Code for Magic Cockpit +' +' @copyright 2024 Siegrist & Tschuor AG +' @author Marco Grätsch +' +Public Const PWD As String = "paddyhat" +Public Const SECTION_IMAGE As String = "Image" +Public Const SECTION_DOCUMENT As String = "Document" +Public Const SHEET_CONFIG As String = "Konfiguration" +Public Const SHEET_ROOTDATA As String = "Auftragsdaten" + +' Save a document as PDF +Sub SaveDocument(sourceName As String, section As String, Optional childPath As String) + Dim fullPath As String + Dim projectDir As String + + projectDir = projectPath(section, childPath) + fullPath = projectDir & "\" & sourceName + + ActiveWorkbook.Save + With Sheets(sourceName) + .Select + .ExportAsFixedFormat Type:=xlTypePDF, _ + Filename:=fullPath & ".pdf", _ + Quality:=xlQualityStandard + End With +End Sub + +' Generate the current project path +Public Function projectPath(section As String, Optional childPath As String) As String + Dim rootPath As String + Dim projectName As String + Dim typePath As String + + With Sheets(SHEET_CONFIG) + rootPath = .Range("B2").Value + projectName = .Range("B3").Value + If section = SECTION_IMAGE Then + typePath = .Range("B4").Value + ElseIf section = SECTION_DOCUMENT Then + typePath = .Range("B5").Value + Else + typePath = "" + End If + End With + + If childPath <> "" And typePath <> "" Then + typePath = typePath & "\" & childPath + End If + + projectPath = rootPath & "\" & projectName & "\" & typePath +End Function + +' Create a subdirectory +Private Sub CreateDir(strPath As String) + Dim el As Variant + Dim strCheckPath As String + + strCheckPath = "" + For Each el In Split(strPath, "\") + strCheckPath = strCheckPath & el & "\" + If Len(Dir(strCheckPath, vbDirectory)) = 0 Then MkDir strCheckPath + Next +End Sub + +' Initialize the project folder +Private Sub InitProjectDir() + CreateDir (projectPath(SECTION_IMAGE)) + CreateDir (projectPath(SECTION_DOCUMENT)) +End Sub + +' Initialize the project folder handler +Sub InitProject_click() + Dim yesno As Integer + yesno = MsgBox("Der Projektordner wird initialisiert. Sind sie sicher?", _ + vbQuestion + vbYesNo + vbDefaultButton2, "Cockpit initialisieren") + If yesno = vbYes Then + InitProjectDir + ActiveWorkbook.Save + MsgBox ("Der Projektordner wurde erfolgreich initialisiert.") + End If +End Sub diff --git a/src/DieseArbeitsmappe.cls b/src/DieseArbeitsmappe.cls new file mode 100644 index 0000000..bb9034e --- /dev/null +++ b/src/DieseArbeitsmappe.cls @@ -0,0 +1,33 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "DieseArbeitsmappe" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Option Explicit +' +' Workbook event-handler for Magic Cockpit +' +' @copyright 2024 Siegrist & Tschuor AG +' @author Marco Grätsch +' +Private Sub Workbook_Open() + Dim fileFolder As String + Dim projectName As String + Dim rootFolder As String + + fileFolder = ThisWorkbook.Path + projectName = Right(fileFolder, Len(fileFolder) - InStrRev(fileFolder, "\")) + rootFolder = Left(fileFolder, Len(fileFolder) - Len(projectName)) + + With Sheets(SHEET_CONFIG) + .Unprotect PWD + .Range("B3").Value = projectName + .Range("B2").Value = rootFolder + .Protect PWD + End With +End Sub + diff --git a/src/ImageHandler.bas b/src/ImageHandler.bas new file mode 100644 index 0000000..f2baebb --- /dev/null +++ b/src/ImageHandler.bas @@ -0,0 +1,100 @@ +Attribute VB_Name = "ImageHandler" +Option Explicit +' +' Image Handler-for Magic Cockpit +' +' @copyright 2024 Siegrist & Tschuor AG +' @author Marco Grätsch +' +Public Const SCALE_FACTOR As Double = 0.5 + +Sub InsertImage_click() + InsertImage _ + target:=ActiveCell.MergeArea, _ + Sheet:=ActiveSheet, _ + FitCell:=True, _ + Padding:=5 +End Sub + +Private Sub InsertImage( _ + target As Range, _ + Sheet As Worksheet, _ + Optional Width As Double = 0, _ + Optional Padding As Integer = 0, _ + Optional ForceWidth As Boolean = False, _ + Optional FitCell As Boolean = True _ + ) + + With Application.FileDialog(msoFileDialogFilePicker) + .AllowMultiSelect = False + .ButtonName = "Bild einfügen" + .Title = "Bild auswählen" + .Filters.Clear + .Filters.Add "Alle Bilddateien", "*.jpg;*.jpeg;*.png;*.webp;*.svg;*.tiff" + .Filters.Add "Bitmap-Dateien", "*.jpg;*.jpeg;*.png;*.webp" + .Filters.Add "Vektor-Grafiken", "*.svg;*.tiff" + + If .Show = -1 Then + Dim source As String + source = .SelectedItems(1) + + Dim img As Object + Set img = Sheet.Pictures.Insert(source) + + With img + 'Scale image size + .ShapeRange.ScaleWidth SCALE_FACTOR, msoFalse, msoScaleFromTopLeft + .ShapeRange.ScaleHeight SCALE_FACTOR, msoFalse, msoScaleFromTopLeft + + If FitCell = True Then + .Placement = xlMoveAndSize + .Width = calcWidth(target.Width, Padding) + Else + 'Set image sizes in points (72 point per inch) + If ForceWidth <> True Then + If .Width >= .Height Then + 'Landscape + .Height = cm2pt(Width) + Else + 'Portrait + .Width = cm2pt(Width) + End If + Else + .Width = cm2pt(Width) + End If + End If + + 'Position Image + .Left = calcLeft(target.Left, Padding) + .Top = calcTop(target.Top, Padding) + End With + target.Columns(6).Select + End If + End With +End Sub + +Private Function calcWidth(CellWidth As Integer, Padding As Integer) + calcWidth = CellWidth - (Padding * 2) +End Function + +Private Function calcTop(Top As Integer, Padding As Integer) + calcTop = Top + Padding +End Function + +Private Function calcLeft(Left As Integer, Padding As Integer) + calcLeft = Left + Padding +End Function + +Private Function cm2pt(Length As Double) + Dim factor As Double + factor = 72 / 2.54 + + cm2pt = Length * factor +End Function + +Private Function pt2cm(Length As Integer) + Dim factor As Double + factor = 2.54 / 72 + + pt2cm = Length * factor +End Function diff --git a/src/LayoutHandler.bas b/src/LayoutHandler.bas new file mode 100644 index 0000000..139869d --- /dev/null +++ b/src/LayoutHandler.bas @@ -0,0 +1,33 @@ +Attribute VB_Name = "LayoutHandler" +Option Explicit + +Sub InsertImageRow_click() + InsertImageRow source:=Range("A131:J133") +End Sub + +Private Sub InsertImageRow(source As Range) + Dim currentRow As Integer + Dim nextRow As Integer + Dim imageNumber As Variant + + currentRow = source.Row + nextRow = currentRow + 3 + + Application.ScreenUpdating = False + source.Copy Destination:=Range("A" & CStr(nextRow)) + imageNumber = Range("B" & CStr(currentRow)).Value + Range("B" & CStr(nextRow)).Value = imageNumber + 1 + With Range("A" & CStr(nextRow + 1)) + .Select + .RowHeight = Range("A" & CStr(currentRow + 1)).RowHeight + End With + With Range("A" + CStr(nextRow + 2)) + .RowHeight = Range("A" & CStr(currentRow + 2)).RowHeight + End With + Application.ScreenUpdating = True +End Sub + +Private Sub InsertPageBreak() + ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell +End Sub + diff --git a/src/RootdataPage.bas b/src/RootdataPage.bas new file mode 100644 index 0000000..0c5ef0e --- /dev/null +++ b/src/RootdataPage.bas @@ -0,0 +1,228 @@ +Attribute VB_Name = "RootdataPage" +Option Explicit +' +' Rootpage code for Magic Cockpit +' +' @copyright 2024 Siegrist & Tschuor AG +' @author Marco Grätsch +' + +' Save the document as PDF handler +Sub ExportRootpage_click() + SaveRootPage +End Sub + +' Reset the whole document handler +Sub ResetRootpage_click() + ResetRootPage +End Sub + +' Set the order date to today handler +Sub OrderDate_click() + With Sheets(SHEET_ROOTDATA) + .Range("C5").Value = Date + End With +End Sub + +' Set the incident date to today handler +Sub IncidentDate_click() + With Sheets(SHEET_ROOTDATA) + .Range("I5").Value = Date + End With +End Sub + +' Set the incident date to yesterday handler +Sub IncidentDateYesterday_click() + With Sheets(SHEET_ROOTDATA) + .Range("I5").Value = Date - 1 + End With +End Sub + +' Validate and save the root data page as PDF +Private Sub SaveRootPage() + Application.ScreenUpdating = False + + Dim message As String + message = ValidateSheet() + If message <> "" Then + MsgBox (message) + GoTo endMakro + End If + + With Sheets(SHEET_ROOTDATA) + .Unprotect PWD + SaveDocument sourceName:=.name, section:=SECTION_DOCUMENT + End With + +endMakro: + Sheets(SHEET_ROOTDATA).Protect PWD + Application.ScreenUpdating = True +End Sub + +' Reset the root data page +Private Sub ResetRootPage() + Dim yesno As Integer + yesno = MsgBox("Durch diese Aktion werden alle Daten gelöscht! Sind sie sicher?", _ + vbExclamation + vbYesNo + vbDefaultButton2, _ + "Auftragsdaten zurücksetzen" _ + ) + + If yesno = vbYes Then + Application.ScreenUpdating = False + With Sheets(SHEET_ROOTDATA) + .Unprotect PWD + + ' Row 1 + .Range("C5").MergeArea.ClearContents + .Range("C6").MergeArea.ClearContents + .Range("C7").MergeArea.ClearContents + .Range("C8").MergeArea.ClearContents + .Range("C9").MergeArea.ClearContents + .Range("I5").MergeArea.ClearContents + .Range("I6").MergeArea.ClearContents + .Range("I7").MergeArea.ClearContents + .Range("I8").MergeArea.ClearContents + .Range("I9").MergeArea.ClearContents + .Range("I10").MergeArea.ClearContents + .Range("I11").MergeArea.ClearContents + + ' Row 2 + .Range("B14").MergeArea.ClearContents + .Range("B15").MergeArea.ClearContents + .Range("B16").MergeArea.ClearContents + .Range("B17:B19").ClearContents + .Range("C17").MergeArea.ClearContents + .Range("C18").MergeArea.ClearContents + .Range("C19").MergeArea.ClearContents + .Range("H14").MergeArea.ClearContents + .Range("H15").MergeArea.ClearContents + .Range("H16").MergeArea.ClearContents + .Range("H17:H19").ClearContents + .Range("I17").MergeArea.ClearContents + .Range("I18").MergeArea.ClearContents + .Range("I19").MergeArea.ClearContents + + ' Row 3 + .Range("B22").MergeArea.ClearContents + .Range("B23").MergeArea.ClearContents + .Range("B24").MergeArea.ClearContents + .Range("B25:B27").ClearContents + .Range("C25").MergeArea.ClearContents + .Range("C26").MergeArea.ClearContents + .Range("C27").MergeArea.ClearContents + .Range("H22").MergeArea.ClearContents + .Range("H23").MergeArea.ClearContents + .Range("H24").MergeArea.ClearContents + .Range("H25:H27").ClearContents + .Range("I25").MergeArea.ClearContents + .Range("I26").MergeArea.ClearContents + .Range("I27").MergeArea.ClearContents + + ' Row 4 + .Range("B30").MergeArea.ClearContents + .Range("B31").MergeArea.ClearContents + .Range("B32").MergeArea.ClearContents + .Range("B33").MergeArea.ClearContents + .Range("B34").MergeArea.ClearContents + .Range("B35:B36").ClearContents + .Range("H30").MergeArea.ClearContents + .Range("H31").MergeArea.ClearContents + .Range("H32").MergeArea.ClearContents + .Range("H33:H35").ClearContents + .Range("H36").MergeArea.ClearContents + .Range("I33").MergeArea.ClearContents + .Range("I34").MergeArea.ClearContents + .Range("I35").MergeArea.ClearContents + + ' Row 5 + .Range("C39").MergeArea.ClearContents + + ' Row 6 + .Range("A42").MergeArea.ClearContents + .Range("A43").MergeArea.ClearContents + .Range("A44").MergeArea.ClearContents + .Range("A45").MergeArea.ClearContents + .Range("A46").MergeArea.ClearContents + + .Range("C5").Select + .Protect PWD + End With + + ActiveWindow.ScrollRow = 1 + ActiveWorkbook.Save + Application.ScreenUpdating = True + End If +End Sub + +' Validate the data before saving the document +Private Function ValidateSheet() As String + Dim errMsg As String + errMsg = "" + + With Sheets(SHEET_ROOTDATA) + If .Range("C5").Value = "" Then + errMsg = "Das Auftragsdatum muss angegeben werden!" + .Range("C5").Select + ActiveWindow.ScrollRow = 3 + GoTo result + End If + If .Range("C6").Value = "" Then + errMsg = "Die Auftragsnummer muss angegeben werden!" + .Range("C6").Select + ActiveWindow.ScrollRow = 3 + GoTo result + End If + If .Range("C7").Value = "" Then + errMsg = "Die Auftragsart muss angegeben werden!" + .Range("C7").Select + ActiveWindow.ScrollRow = 3 + GoTo result + End If + If .Range("C8").Value = "" Then + errMsg = "Der Auftragsstatus muss angegeben werden!" + .Range("C8").Select + ActiveWindow.ScrollRow = 3 + GoTo result + End If + If .Range("C9").Value = "" Then + errMsg = "Der Sachbearbeiter muss angegeben werden!" + .Range("C9").Select + ActiveWindow.ScrollRow = 3 + GoTo result + End If + If .Range("B22").Value = "" Then + errMsg = "Der Name des Schadensobjekts muss angegeben werden!" + .Range("B22").Select + ActiveWindow.ScrollRow = 20 + GoTo result + End If + If .Range("B23").Value = "" Then + errMsg = "Die Adresse des Schadensobjekts muss angegeben werden!" + .Range("B23").Select + ActiveWindow.ScrollRow = 20 + GoTo result + End If + If .Range("B24").Value = "" Then + errMsg = "Die Adresse des Schadensobjekts muss angegeben werden!" + .Range("B24").Select + ActiveWindow.ScrollRow = 20 + GoTo result + End If + If .Range("B25").Value = "" Then + errMsg = "Der Haustyp des Schadensobjekts muss angegeben werden!" + .Range("B25").Select + ActiveWindow.ScrollRow = 20 + GoTo result + End If + If .Range("C31").Value = "" Then + errMsg = "Bitte den Schaden beschreiben!" + .Range("C31").Select + ActiveWindow.ScrollRow = 29 + GoTo result + End If + End With + +result: + ValidateSheet = errMsg +End Function + diff --git a/src/Tabelle1.cls b/src/Tabelle1.cls new file mode 100644 index 0000000..de46ed5 --- /dev/null +++ b/src/Tabelle1.cls @@ -0,0 +1,11 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Tabelle1" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Option Explicit + diff --git a/src/Tabelle2.cls b/src/Tabelle2.cls new file mode 100644 index 0000000..0881a54 --- /dev/null +++ b/src/Tabelle2.cls @@ -0,0 +1,11 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Tabelle2" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Option Explicit + diff --git a/src/Tabelle3.cls b/src/Tabelle3.cls new file mode 100644 index 0000000..f3f5283 --- /dev/null +++ b/src/Tabelle3.cls @@ -0,0 +1,11 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Tabelle3" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Option Explicit + diff --git a/src/Tabelle4.cls b/src/Tabelle4.cls new file mode 100644 index 0000000..34162b2 --- /dev/null +++ b/src/Tabelle4.cls @@ -0,0 +1,11 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Tabelle4" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Option Explicit + diff --git a/src/Tabelle5.cls b/src/Tabelle5.cls new file mode 100644 index 0000000..6f9f76e --- /dev/null +++ b/src/Tabelle5.cls @@ -0,0 +1,11 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Tabelle5" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Option Explicit + diff --git a/src/Tabelle6.cls b/src/Tabelle6.cls new file mode 100644 index 0000000..3a47495 --- /dev/null +++ b/src/Tabelle6.cls @@ -0,0 +1,11 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Tabelle6" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Option Explicit +