Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "DieseArbeitsmappe"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Option Explicit

Private Const FIELD_TMPOGORPHANDOCCHECKED = "TMPOGOrphanDocChecked"

#If VBA7 Then '// 2013-09-11 FS: 64 bit compatibility
Private Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Public NotesThisUiDoc As Object
Public NotesThisDoc As Object
Public NotesUIWorkspace As Object
Public NotesThisDatabase As Object
Public NotesSession As Object

Public docFullName As String
Dim lastRevisionNumber As Integer
Dim cachedObjects(0 To 3) As Variant
Dim blnReadOnly As Boolean
Dim blnAlwaysTreatAsModifiedOnClose As Boolean

Sub OgTest()
     MsgBox NotesThisDoc.GetItemValue("wpActiveDocument")(0)
End Sub

Public Function OgMsgBox(pPar1, pPar2, pPar3)
     OgMsgBox = MsgBox(pPar1, pPar2, pPar3)
End Function

Public Sub OgAppActivate(pPar)
    AppActivate (pPar)
End Sub

Public Sub SetNotesWindowState(pPar)
#If VBA7 Then
    Dim handle As LongPtr
#Else
    Dim handle As Long
#End If
    handle = FindWindow(vbNullString, NotesThisUiDoc.WindowTitle)
    If handle = 0 Then handle = FindWindow(vbNullString, NotesThisUiDoc.WindowTitle & " - IBM Notes") '// 2013-09-17 FS: update application title for window identification (formerly "Lotus Notes", "IBM Lotus Notes")
    If handle <> 0 Then Call ShowWindow(handle, pPar)
End Sub

Public Sub IconifyNotes()
    Call SetNotesWindowState(2)
End Sub

Public Sub MaximizeNotes()
    Call SetNotesWindowState(3)
End Sub

Private Sub UpdateOrphanCheckField()
    If Not NotesThisDoc Is Nothing Then
        If NotesThisDoc.GetItemValue(FIELD_TMPOGORPHANDOCCHECKED)(0) = "1" Then
            NotesThisDoc.ReplaceItemValue(FIELD_TMPOGORPHANDOCCHECKED, "2").SaveToDisk = False
        End If
    End If
End Sub

Private Sub ResetOrphanCheckField()
    If Not NotesThisDoc Is Nothing Then
        If NotesThisDoc.GetItemValue(FIELD_TMPOGORPHANDOCCHECKED)(0) = "2" Then
            NotesThisDoc.ReplaceItemValue(FIELD_TMPOGORPHANDOCCHECKED, "1").SaveToDisk = False
        End If
    End If
End Sub


Public Sub IsSaved()
    ThisWorkbook.Saved = True
End Sub

Public Sub OGPostOpen_Excel()

    Application.ActiveWindow.Activate

    If ThisWorkbook.ReadOnly Then
        'ThisWorkbook.Activate '// 2013-11-29 FS: do not jump to first worksheet
        blnReadOnly = True
        MsgBox "Dokument ist schreibgeschützt - Änderungen werden ignoriert.", vbExclamation, "Dokument öffnen"
    End If

    lastRevisionNumber = 0

    docFullName = ThisWorkbook.FullName
    
    Set NotesUIWorkspace = CreateObject("Notes.NotesUiWorkspace")
    Set NotesSession = CreateObject("Notes.NotesSession")
    Set NotesThisDatabase = NotesSession.currentDatabase
    Set NotesThisUiDoc = NotesUIWorkspace.CurrentDocument

    '// FS 20060202: Allow initialization when NotesThisUiDoc is unavailable for calls with backend documents.
    '// FS 20041025: May indicate second Notes instance is running and no database or document is open.
    If NotesThisDatabase Is Nothing Then
        Set NotesThisDoc = Nothing
        Set NotesThisUiDoc = Nothing
        Set NotesUIWorkspace = Nothing
        Set NotesSession = Nothing
        Set NotesThisDatabase = Nothing
        MsgBox "Beim Ermitteln des zugehörigen Notes-Dokuments ist ein Fehler aufgetreten. Vermutlich laufen zur Zeit mehrere Notes Client-Anwendungen auf ihrem Rechner. Wenn diese der Fall ist, schließen Sie bitte die gerade nicht benötigte Notes-Anwendung. Alle Änderungen, die Sie im Office-Dokument noch machen, können aufgrund dieses Problems nicht nach Notes zurückgeschrieben werden.", vbExclamation, "OfficeGateway"
        Exit Sub
    End If
    
    If Not NotesThisUiDoc Is Nothing Then
        Set NotesThisDoc = NotesThisUiDoc.Document
        '// FS 20041025: May indicate wrong document was located in second Notes instance.
        If NotesThisDoc.GetItemValue("wpActiveDocument")(0) <> ThisWorkbook.Name Then
            Set NotesThisDoc = Nothing
            Set NotesThisUiDoc = Nothing
            Set NotesUIWorkspace = Nothing
            Set NotesSession = Nothing
            Set NotesThisDatabase = Nothing
            MsgBox "Das zugehörige Notes-Dokument ist nicht korrekt. Vermutlich laufen zur Zeit mehrere Notes Client-Anwendungen auf ihrem Rechner. Wenn diese der Fall ist, schließen Sie bitte die gerade nicht benötigte Notes-Anwendung. Alle Änderungen, die Sie im Office-Dokument noch machen, können aufgrund dieses Problems nicht nach Notes zurückgeschrieben werden.", vbExclamation, "OfficeGateway"
            Exit Sub
        ElseIf Not ThisWorkbook.ReadOnly Then
            '// orphan check field
            Call UpdateOrphanCheckField
        End If
        blnAlwaysTreatAsModifiedOnClose = (NotesThisDoc.GetItemValue("wpAlwaysTreatAsModifiedOnClose")(0) = "1")
    End If

End Sub

Private Sub Workbook_BeforeSave(ByVal SpeichernAlsDialogfeld As Boolean, Abbrechen As Boolean)
    
    lastRevisionNumber = lastRevisionNumber + 1

End Sub

Private Sub Workbook_BeforeClose(Abbrechen As Boolean)

    Dim modified, sSaved
    Dim ThisDocument
    Dim returnStringQuerySaveEvent

    Set ThisDocument = ThisWorkbook

    If blnReadOnly Then
        ThisDocument.Saved = True
        Exit Sub
    End If
    
    '// Saved verändert seinen Wert
    sSaved = ThisDocument.Saved

    modified = (Not sSaved) Or (ThisDocument.FullName <> docFullName) Or (lastRevisionNumber <> 0)
    modified = modified Or blnAlwaysTreatAsModifiedOnClose '// @ 2013-09-04 FS: always treat document as modified upon closing
    
    If modified And Not NotesThisUiDoc Is Nothing Then
        Select Case MsgBox("Sollen die Änderungen im zugehörigen Notes-Dokument gespeichert werden?", vbYesNoCancel + vbQuestion)
            Case vbYes
                Call NotesThisDoc.ReplaceItemValue("wpAttachFile", "?")

                On Error Resume Next
                Call NotesThisUiDoc.Refresh
                Call NotesThisUiDoc.Refresh  '//2. Mal, damit der Bildschrim aktualisiert wird
                On Error GoTo 0
                Err = 0
                returnStringQuerySaveEvent = NotesThisDoc.GetItemValue("wpAttachFile")(0)

                If returnStringQuerySaveEvent = "-" Then
                    sSaved = True

                ElseIf returnStringQuerySaveEvent <> "" Then
                    If returnStringQuerySaveEvent = "?" Then
                        returnStringQuerySaveEvent = "Internal OfficeGateway error when processing events"
                    End If
                    Call MsgBox(returnStringQuerySaveEvent, vbExclamation)
                    Abbrechen = True
                    Exit Sub

                Else
                    '// 2013-09-17 FS: save with local settings to prevent VBA localization (usually US English) from corrupting currency formats
                    If ThisDocument.FullName = docFullName Then
                        'Call ThisDocument.Save
                        Application.DisplayAlerts = False
                        Call ThisWorkbook.SaveAs(docFullName, Local:=True)
                        Application.DisplayAlerts = True

                    Else
                        On Error Resume Next
                        Kill docFullName
                        Err = 0
                        On Error GoTo 0
                        Call ThisDocument.SaveAs(docFullName, Local:=True)
                    End If

                    sSaved = True

                    Call NotesThisDoc.ReplaceItemValue("wpAttachFile", "1")

                    On Error Resume Next
                    Call NotesThisUiDoc.Refresh
                    Call NotesThisUiDoc.Refresh  '//2. Mal, damit der Bildschrim aktualisiert wird
                    On Error GoTo 0
                    Err = 0
                End If

            Case vbNo
                sSaved = True

            Case vbCancel
                Abbrechen = True
                Exit Sub
        End Select
    End If
    
    '// orphan check field
    Call ResetOrphanCheckField

    If sSaved Then
        Set NotesThisDoc = Nothing
        Set NotesThisUiDoc = Nothing
        Set NotesUIWorkspace = Nothing
        Set NotesThisDatabase = Nothing
        Set NotesSession = Nothing

        Application.WindowState = xlMinimized
    End If

    ThisDocument.Saved = sSaved
    
End Sub


Attribute VB_Name = "Tabelle23"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
'< protected by www.CrunchCode.de - DO NOT CHANGE OR REMOVE THIS LABEL! >

Option Explicit

Attribute VB_Name = "sXRhvBgwveYGTWVyAPxSOXkdSRABC"
'< protected by www.CrunchCode.de - DO NOT CHANGE OR REMOVE THIS LABEL! >

Option Explicit
Sub pnYmGEucmQEaXkgzxkZGghxHgllxB(lbEkTSRs As _
Boolean)
With StartGUI
If _
lbEkTSRs = True Then
.CSwekbPMpVSHHTjrMohcaGTNwOsMuwb.Visible = _
True
.ryBHsoKAWoMzQocc.Visible = _
True: .ShortCutLBL.Visible = _
True
.hkcWMURklM.Visible = _
True
.HQXcVQNtZKZmTQHBCxWubXRIy.Visible = _
True
.ShortCutRahmLBL.Visible = _
True
Else
.CSwekbPMpVSHHTjrMohcaGTNwOsMuwb.Visible = False
.ryBHsoKAWoMzQocc.Visible = False: .ShortCutLBL.Visible = False: .hkcWMURklM.Visible = False: .HQXcVQNtZKZmTQHBCxWubXRIy.Visible = False: .ShortCutRahmLBL.Visible = False
End If
End With
End Sub
Sub _
cntjflsSrTBqwD()
Dim _
JJNnGujzQEN As _
Variant
Dim hXHDyIEOaRYpQEvYVknKlhcGPFuM As _
Integer
Dim _
EIcKlxWFjSffNdSZXjIsQdOZi As _
Boolean
If _
FsgxCouSfFNcSHdhLJmUT.Cells( _
2, 50).Value > _
FsgxCouSfFNcSHdhLJmUT.Cells( _
3, _
50).Value Then
EIcKlxWFjSffNdSZXjIsQdOZi = True
Else
EIcKlxWFjSffNdSZXjIsQdOZi = _
False
End If
With _
StartGUI
If TpVtiJlrXGLbE.Cells( _
17, 8).Value <> _
"" And _
EIcKlxWFjSffNdSZXjIsQdOZi = _
False Then
JJNnGujzQEN = _
Split(TpVtiJlrXGLbE.Cells(17, 8).Value, Chr(10))
For hXHDyIEOaRYpQEvYVknKlhcGPFuM = 0 To UBound(JJNnGujzQEN)
.TjmeMDvRTtIvwXzDtjNaEqstgWiwT.AddItem JJNnGujzQEN(hXHDyIEOaRYpQEvYVknKlhcGPFuM)
Next hXHDyIEOaRYpQEvYVknKlhcGPFuM
ElseIf _
owCLiFVnSMZ.Cells( _
9, _
4).Value <> "" Then
JJNnGujzQEN = Split(owCLiFVnSMZ.Cells( _
9, _
4).Value, _
Chr(10))
For _
hXHDyIEOaRYpQEvYVknKlhcGPFuM = 0 To UBound( _
JJNnGujzQEN)
.TjmeMDvRTtIvwXzDtjNaEqstgWiwT.AddItem JJNnGujzQEN( _
hXHDyIEOaRYpQEvYVknKlhcGPFuM): Next hXHDyIEOaRYpQEvYVknKlhcGPFuM
End If
If _
TpVtiJlrXGLbE.Cells( _
28, _
8).Value = "" Then
.XFgOeBGMiNTxWcwP.Value = wOXEhizgpJqFgGxGixoxUU.Cells(21, 3).Value
Else
.XFgOeBGMiNTxWcwP.Value = TpVtiJlrXGLbE.Cells(28, _
8).Value
End If
If TpVtiJlrXGLbE.Cells(13, 8).Value = _
"" Then
.PlAnzMitTB.Value = _
wOXEhizgpJqFgGxGixoxUU.Cells( _
23, 5).Value
Else
.PlAnzMitTB.Value = _
TpVtiJlrXGLbE.Cells(13, 8).Value
End If: .PlAuditTB.Value = TpVtiJlrXGLbE.Cells(30, 24).Value
.PlDokAusTB.Value = TpVtiJlrXGLbE.Cells( _
15, 11).Value: .PlAnzSchichtTB.Value = _
TpVtiJlrXGLbE.Cells( _
13, 24).Value
If _
TpVtiJlrXGLbE.Cells( _
30, _
8).Value <> "" And _
EIcKlxWFjSffNdSZXjIsQdOZi = False Then
.PlLeitAuditTB.Value = _
TpVtiJlrXGLbE.Cells( _
30, 8).Value
ElseIf _
owCLiFVnSMZ.Cells(7, 28).Value <> _
"" Then
.PlLeitAuditTB.Value = _
owCLiFVnSMZ.Cells(7, _
28).Value
End If
If _
TpVtiJlrXGLbE.Cells( _
45, 6).Value <> _
"" And EIcKlxWFjSffNdSZXjIsQdOZi = _
False Then
.PlErstDatTB.Value = _
TpVtiJlrXGLbE.Cells( _
45, _
6).Value
ElseIf _
owCLiFVnSMZ.Cells(5, _
28).Value <> _
"" And _
EIcKlxWFjSffNdSZXjIsQdOZi = _
True Then
.PlErstDatTB.Value = _
owCLiFVnSMZ.Cells(5, _
28).Value
Else
.PlErstDatTB.Value = Date
End If
If TpVtiJlrXGLbE.Cells(13, 28).Value = _
"pro Woche" Then
.tvSPscGNQOpwd.Value = True
Else
.KIDjnzQzudrtIQKJNIW.Value = _
True
End If
If _
TpVtiJlrXGLbE.Cells( _
41, 8).Value = _
"englisch" Then
.ZIpQDtdglbtyBnzYPwqGBrEjgddcTh.Value = True
Else
.oNMfaDGTM.Value = _
True
End If
If _
TpVtiJlrXGLbE.Cells( _
17, 8).Value <> _
"" Then
If _
TpVtiJlrXGLbE.Cells(48, 5).Value = "x" Then .rJekNDhZI.Value = _
True
If TpVtiJlrXGLbE.Cells(48, 13).Value = _
"x" Then .rGECQzoYvDOBWGVylCdBLoxTz.Value = True
If TpVtiJlrXGLbE.Cells(48, _
21).Value = _
"x" Then .NlScIQlJOG.Value = True
Else
.rJekNDhZI.Value = _
True
.NlScIQlJOG.Value = True
.rGECQzoYvDOBWGVylCdBLoxTz.Value = _
True
End If
If TpVtiJlrXGLbE.Cells(19, _
7).Value = _
"x" Then
.zvKeVvebbwlpvcwQQlTNmvoVYY.Value = _
True
Else
.zvKeVvebbwlpvcwQQlTNmvoVYY.Value = False: End If
If _
TpVtiJlrXGLbE.Cells(21, 7).Value = "x" Then
.ZTKZoLsNhQjg.Value = _
True
Else
.ZTKZoLsNhQjg.Value = False
End If
If TpVtiJlrXGLbE.Cells(23, _
7).Value = _
"x" Then
.bWyBbyCyXLaPegzuwfWpq.Value = _
True
Else
.bWyBbyCyXLaPegzuwfWpq.Value = False
End If
If _
TpVtiJlrXGLbE.Cells( _
26, _
7).Value = _
"x" Then
.OGBaNOeDHMKxYixqlVTsDTshLe.Value = True
Else
.OGBaNOeDHMKxYixqlVTsDTshLe.Value = _
False
End If
.ePRidkUwmcB.Value = _
TpVtiJlrXGLbE.Cells( _
35, _
15).Value
.PlBeobachtTB.Value = _
TpVtiJlrXGLbE.Cells(37, _
15).Value
.PlFachexpTB.Value = TpVtiJlrXGLbE.Cells(39, _
15).Value: End With
End Sub
Sub RTrWgMMWPcjKlHVmT(bJntnSAFNZt As Integer)
Dim _
GKPdlOpDVsSnaRrqyHyxTxtbCywKghu As _
Variant
Dim fBLFIRYCgQkFShVMeZgdvnLqNfQxr As Integer
Dim _
AVCqzjAxqqx As Double
Call sdjCaUEZdUrOQDZd
With _
StartGUI
.NEXardecfsNMevQiwSmQQMMmeEwD.Value = _
0
If TpVtiJlrXGLbE.Cells( _
bJntnSAFNZt, 30).Value = "nein" Then
.oKyaffUkuScJrkRecC.Value = True
Else
.rrJZJKCOAYNrxBlPIjCiQqHz.Value = True: End If
If TpVtiJlrXGLbE.Cells(bJntnSAFNZt, 1).Value <> _
"" Then
GKPdlOpDVsSnaRrqyHyxTxtbCywKghu = Split(TpVtiJlrXGLbE.Cells(bJntnSAFNZt, _
1), _
Chr( _
10))
.PlSt1DatTB.Value = _
GKPdlOpDVsSnaRrqyHyxTxtbCywKghu(0)
.PlSt1VonTB.Value = _
Trim(Left( _
GKPdlOpDVsSnaRrqyHyxTxtbCywKghu( _
1), InStr(GKPdlOpDVsSnaRrqyHyxTxtbCywKghu( _
1), "-") - 1)): .PlSt1BisTB.Value = _
Trim(Mid( _
GKPdlOpDVsSnaRrqyHyxTxtbCywKghu( _
1), InStr(GKPdlOpDVsSnaRrqyHyxTxtbCywKghu(1), "-") + _
1))
Else
.PlSt1DatTB.Value = "": .PlSt1VonTB.Value = _
""
.PlSt1BisTB.Value = "": End If
For fBLFIRYCgQkFShVMeZgdvnLqNfQxr = _
43 To _
46
AVCqzjAxqqx = AVCqzjAxqqx + TpVtiJlrXGLbE.Cells( _
bJntnSAFNZt, _
fBLFIRYCgQkFShVMeZgdvnLqNfQxr).Value
Next fBLFIRYCgQkFShVMeZgdvnLqNfQxr: .PlSt1hTB.Value = _
AVCqzjAxqqx
.PlSt114TB.Value = _
TpVtiJlrXGLbE.Cells( _
bJntnSAFNZt, 44).Value
.PlSt145TB.Value = _
TpVtiJlrXGLbE.Cells( _
bJntnSAFNZt, _
45).Value: .PlSt19TB.Value = _
TpVtiJlrXGLbE.Cells( _
bJntnSAFNZt, _
43).Value
.PlSt150TB.Value = _
TpVtiJlrXGLbE.Cells(bJntnSAFNZt, 46).Value: End With
End Sub
Sub _
RbrLQlCVcs()
Dim _
gzYOMktaSCzEHUINugOfv As Integer
Dim _
VdkKBnQznOkLSFqTXLYngCJNVz As Variant
Dim hYdrkiEKHEwciEROsgpzo As Integer
Dim BZdhXDfaEm As Integer
cRMVMAUo = False
For gzYOMktaSCzEHUINugOfv = _
0 To StartGUI.TjmeMDvRTtIvwXzDtjNaEqstgWiwT.ListCount - 1
If InStr( _
StartGUI.TjmeMDvRTtIvwXzDtjNaEqstgWiwT.List(gzYOMktaSCzEHUINugOfv), "50001") > 0 Then cRMVMAUo = _
True
Next gzYOMktaSCzEHUINugOfv
If cRMVMAUo = _
True Then
hYdrkiEKHEwciEROsgpzo = 72
Else
hYdrkiEKHEwciEROsgpzo = _
68
End If
With StartGUI.rSxrfmBNgCIuxmSnOPaNKUmAoaIr
.Clear
BZdhXDfaEm = _
2
For _
gzYOMktaSCzEHUINugOfv = 63 To _
hYdrkiEKHEwciEROsgpzo
.AddItem: .List(.ListCount - _
1, 0) = _
FsgxCouSfFNcSHdhLJmUT.Cells( _
BZdhXDfaEm, 34).Value
BZdhXDfaEm = BZdhXDfaEm + 1
If TpVtiJlrXGLbE.Cells(gzYOMktaSCzEHUINugOfv, _
1).Value <> "" Then
VdkKBnQznOkLSFqTXLYngCJNVz = _
Null: VdkKBnQznOkLSFqTXLYngCJNVz = _
Split(TpVtiJlrXGLbE.Cells( _
gzYOMktaSCzEHUINugOfv, _
1).Value, Chr( _
10))
.List(.ListCount - 1, _
1) = _
VdkKBnQznOkLSFqTXLYngCJNVz( _
0)
.List( _
.ListCount - _
1, _
2) = _
VdkKBnQznOkLSFqTXLYngCJNVz( _
1)
End If
If _
TpVtiJlrXGLbE.Cells( _
gzYOMktaSCzEHUINugOfv, 30).Value <> _
"" Then
.List( _
.ListCount - _
1, _
3) = _
TpVtiJlrXGLbE.Cells( _
gzYOMktaSCzEHUINugOfv, 30).Value
End If
Next gzYOMktaSCzEHUINugOfv
End With
End Sub
Sub _
XXWLiIgGvtULXsr( _
zRukTqzGLFqnJwdFayXgl As Worksheet, _
RMuWPWLDqtJdWxYWxOCOt As Object)
Dim _
AdTEcdikcL As Integer: Dim BeWNvCyKefniBIkNRMoNp As Long: BeWNvCyKefniBIkNRMoNp = fllSYPpCtviZnqagjWpfUcAfoeh(zRukTqzGLFqnJwdFayXgl, _
1)
If _
BeWNvCyKefniBIkNRMoNp < 12 Then
MsgBox "Keine Normelemente für die gewählte Norm hinterlegt.", vbExclamation + _
vbOKOnly, _
"Keine Normelemente"
Exit _
Sub
End If
For _
AdTEcdikcL = 0 To RMuWPWLDqtJdWxYWxOCOt.ListCount - _
1
If _
RMuWPWLDqtJdWxYWxOCOt.Selected( _
AdTEcdikcL) = _
True Then
zRukTqzGLFqnJwdFayXgl.Cells( _
CInt( _
RMuWPWLDqtJdWxYWxOCOt.List( _
AdTEcdikcL, 2)), 5).Value = _
"x"
Else
zRukTqzGLFqnJwdFayXgl.Cells(CInt( _
RMuWPWLDqtJdWxYWxOCOt.List(AdTEcdikcL, 2)), 5).Value = ""
End If
Next _
AdTEcdikcL
End Sub
Sub _
tOmQrruacHvtZbUvJOwGJZ()
Dim _
eFDmafyCkqJGgxUzwbQW As _
Double: Dim KscaifK As Double
Dim uOAuxwygMqMQyXDnFBpZNgtqwyDwp As Double
Dim XlBIQHwGjd As _
Double: Dim wJYVSgPptXwkxCuuUrTFFwkhKnCQR As _
Long
wJYVSgPptXwkxCuuUrTFFwkhKnCQR = TpVtiJlrXGLbE.UsedRange.Rows.Count: XlBIQHwGjd = _
0: KscaifK = _
0
eFDmafyCkqJGgxUzwbQW = _
0
uOAuxwygMqMQyXDnFBpZNgtqwyDwp = 0
With _
TpVtiJlrXGLbE
If _
.Cells(60, _
25).Value <> _
"" Then
KscaifK = WorksheetFunction.Sum( _
.Range(.Cells(63, _
44), .Cells( _
72, 44))): eFDmafyCkqJGgxUzwbQW = _
WorksheetFunction.Sum(.Range( _
.Cells( _
63, 45), _
.Cells(72, _
45)))
uOAuxwygMqMQyXDnFBpZNgtqwyDwp = WorksheetFunction.Sum(.Range( _
.Cells( _
63, 46), .Cells( _
72, 46)))
XlBIQHwGjd = WorksheetFunction.Sum(.Range( _
.Cells( _
63, _
43), .Cells( _
72, 43)))
End If
KscaifK = _
KscaifK + _
WorksheetFunction.Sum( _
.Range( _
.Cells( _
76, _
44), _
.Cells(wJYVSgPptXwkxCuuUrTFFwkhKnCQR, _
44))): eFDmafyCkqJGgxUzwbQW = eFDmafyCkqJGgxUzwbQW + WorksheetFunction.Sum(.Range(.Cells(76, 45), .Cells( _
wJYVSgPptXwkxCuuUrTFFwkhKnCQR, _
45)))
uOAuxwygMqMQyXDnFBpZNgtqwyDwp = uOAuxwygMqMQyXDnFBpZNgtqwyDwp + WorksheetFunction.Sum(.Range( _
.Cells(76, 46), _
.Cells( _
wJYVSgPptXwkxCuuUrTFFwkhKnCQR, 46)))
XlBIQHwGjd = _
XlBIQHwGjd + _
WorksheetFunction.Sum(.Range( _
.Cells(76, _
43), _
.Cells(wJYVSgPptXwkxCuuUrTFFwkhKnCQR, 43))): .Cells(58, 19).Value = eFDmafyCkqJGgxUzwbQW
.Cells( _
58, 14).Value = _
KscaifK: .Cells(58, 24).Value = uOAuxwygMqMQyXDnFBpZNgtqwyDwp
.Cells(58, _
9).Value = _
XlBIQHwGjd
End With
End Sub
Sub _
RXUxiAS(rZVTAZHNPzldfiMnFNVXXFXzOgAF As Boolean, _
zEprbozhPFRwidcjaCSnCWWLtcZx As Boolean)
Dim _
UPtLJjpZZkGcV As _
Double
Dim _
quSnSeaxEjhShzBcRXUgtiUtbl As String: Dim _
rMkfXsjQYYCokNfdJ As Integer: Dim tyGCzLnInplaXt As Boolean
Dim _
bVjYFIKrRgl As _
Boolean
Dim YJiGxGBmNrKgkcLKNRqwqddccrcYb As _
Boolean
Dim epVmVqAMV As _
Boolean
rZVTAZHNPzldfiMnFNVXXFXzOgAF = _
False: Call _
mPFhtgRliaGLsELiaWYWAmMELoWvw( _
StartGUI.PlErstDatTB, _
False, StartGUI, _
1, rZVTAZHNPzldfiMnFNVXXFXzOgAF, False)
If _
rZVTAZHNPzldfiMnFNVXXFXzOgAF = _
True Then Exit _
Sub
Call JeuAdTsXegcVuShTUvBRUYyC(StartGUI.XFgOeBGMiNTxWcwP, _
True, _
StartGUI.GIQSJaAIJSDa, 3, rZVTAZHNPzldfiMnFNVXXFXzOgAF, True)
If rZVTAZHNPzldfiMnFNVXXFXzOgAF Then Exit Sub
If StartGUI.TjmeMDvRTtIvwXzDtjNaEqstgWiwT.ListCount < 1 Then
MsgBox "Bitte eine Auditart und Auditgrundlage auswählen.", _
vbExclamation + vbOKOnly, _
"Keine Auswahl"
StartGUI.OtrLxCCc.SetFocus
Exit _
Sub
End If
If _
StartGUI.oNMfaDGTM.Value = False And StartGUI.ZIpQDtdglbtyBnzYPwqGBrEjgddcTh.Value = False Then
MsgBox "Bitte eine Auditsprache auswählen.", _
vbExclamation + vbOKOnly, "Welche Sprache?"
Exit Sub
End If
Call _
JeuAdTsXegcVuShTUvBRUYyC( _
StartGUI.PlLeitAuditTB, _
True, _
StartGUI.GIQSJaAIJSDa, 3, _
rZVTAZHNPzldfiMnFNVXXFXzOgAF, _
True)
If rZVTAZHNPzldfiMnFNVXXFXzOgAF Then Exit _
Sub
If zEprbozhPFRwidcjaCSnCWWLtcZx = _
True Then
Call _
JeuAdTsXegcVuShTUvBRUYyC( _
StartGUI.ePRidkUwmcB, _
True, StartGUI.GIQSJaAIJSDa, _
4, rZVTAZHNPzldfiMnFNVXXFXzOgAF, True)
If rZVTAZHNPzldfiMnFNVXXFXzOgAF Then Exit Sub
End If
With _
StartGUI
TpVtiJlrXGLbE.Cells(5, _
3).Value = wOXEhizgpJqFgGxGixoxUU.Cells( _
7, _
10).Value
TpVtiJlrXGLbE.Cells(7, 3).Value = _
wOXEhizgpJqFgGxGixoxUU.Cells(9, _
10).Value
TpVtiJlrXGLbE.Cells(9, _
3).Value = _
wOXEhizgpJqFgGxGixoxUU.Cells(11, 10).Value
TpVtiJlrXGLbE.Cells( _
11, _
3).Value = wOXEhizgpJqFgGxGixoxUU.Cells( _
13, 10).Value
TpVtiJlrXGLbE.Cells(5, _
19).Value = _
wOXEhizgpJqFgGxGixoxUU.Cells(34, 1).Value
quSnSeaxEjhShzBcRXUgtiUtbl = .TjmeMDvRTtIvwXzDtjNaEqstgWiwT.List(0)
For rMkfXsjQYYCokNfdJ = 1 To .TjmeMDvRTtIvwXzDtjNaEqstgWiwT.ListCount - _
1
quSnSeaxEjhShzBcRXUgtiUtbl = quSnSeaxEjhShzBcRXUgtiUtbl & _
Chr(10) & .TjmeMDvRTtIvwXzDtjNaEqstgWiwT.List(rMkfXsjQYYCokNfdJ)
Next _
rMkfXsjQYYCokNfdJ: UPtLJjpZZkGcV = _
vegrsldODqRzEcBcmoBeocVktEYq( _
TpVtiJlrXGLbE, 8, _
34, 17, quSnSeaxEjhShzBcRXUgtiUtbl, _
jNzZRYBjIJjg, _
True)
TpVtiJlrXGLbE.Cells( _
17, 8).Value = _
quSnSeaxEjhShzBcRXUgtiUtbl
TpVtiJlrXGLbE.Cells( _
17, 8).Value = Replace(TpVtiJlrXGLbE.Cells( _
17, _
8).Value, Chr( _
13), _
"")
If _
UPtLJjpZZkGcV > _
14.3 Then
TpVtiJlrXGLbE.Cells(17, _
8).RowHeight = UPtLJjpZZkGcV
End If
If _
InStr(quSnSeaxEjhShzBcRXUgtiUtbl, "9001") < 1 Then
tyGCzLnInplaXt = _
True
Else
tyGCzLnInplaXt = False
End If
If _
InStr( _
quSnSeaxEjhShzBcRXUgtiUtbl, _
"14001") < 1 Then
bVjYFIKrRgl = _
True
Else
bVjYFIKrRgl = _
False
End If
If _
InStr(quSnSeaxEjhShzBcRXUgtiUtbl, "45001") < 1 Then
YJiGxGBmNrKgkcLKNRqwqddccrcYb = True
Else
YJiGxGBmNrKgkcLKNRqwqddccrcYb = _
False
End If
If InStr(quSnSeaxEjhShzBcRXUgtiUtbl, "50001") < _
1 Then
epVmVqAMV = True
Else
epVmVqAMV = _
False
End If: Call QNgpeoPXApjGlgbwcjDYjEYcv(tyGCzLnInplaXt, bVjYFIKrRgl, YJiGxGBmNrKgkcLKNRqwqddccrcYb, epVmVqAMV)
TpVtiJlrXGLbE.Cells( _
28, _
8).Value = .XFgOeBGMiNTxWcwP.Value
TpVtiJlrXGLbE.Cells(30, 24).Value = .PlAuditTB.Value
TpVtiJlrXGLbE.Cells(15, 11).Value = _
.PlDokAusTB.Value
TpVtiJlrXGLbE.Cells(30, 8).Value = .PlLeitAuditTB.Value
TpVtiJlrXGLbE.Cells( _
45, 20).Value = "gez. " & _
.PlLeitAuditTB.Value
TpVtiJlrXGLbE.Cells(13, 8).Value = _
.PlAnzMitTB.Value
TpVtiJlrXGLbE.Cells( _
13, _
24).Value = .PlAnzSchichtTB.Value
TpVtiJlrXGLbE.Cells(45, _
6).Value = _
.PlErstDatTB.Value
If _
.KIDjnzQzudrtIQKJNIW.Value = _
True Then
TpVtiJlrXGLbE.Cells( _
13, _
28).Value = _
"pro Tag"
Else
TpVtiJlrXGLbE.Cells( _
13, _
28).Value = "pro Woche"
End If
If .oNMfaDGTM.Value = True Then
TpVtiJlrXGLbE.Cells(41, _
8).Value = _
"deutsch"
Else
TpVtiJlrXGLbE.Cells( _
41, 8).Value = "englisch"
End If
If _
.rJekNDhZI.Value = True Then TpVtiJlrXGLbE.Cells( _
48, 5).Value = "x"
If _
.rGECQzoYvDOBWGVylCdBLoxTz.Value = True Then TpVtiJlrXGLbE.Cells( _
48, 13).Value = _
"x"
If _
.NlScIQlJOG.Value = True Then TpVtiJlrXGLbE.Cells( _
48, 21).Value = _
"x"
If .zvKeVvebbwlpvcwQQlTNmvoVYY.Value = True Then
TpVtiJlrXGLbE.Cells(19, 7).Value = "x"
Else
TpVtiJlrXGLbE.Cells( _
19, 7).Value = ""
End If
If _
.ZTKZoLsNhQjg.Value = True Then
TpVtiJlrXGLbE.Cells( _
21, _
7).Value = "x"
Else
TpVtiJlrXGLbE.Cells( _
21, _
7).Value = ""
End If
If .bWyBbyCyXLaPegzuwfWpq.Value = _
True Then
TpVtiJlrXGLbE.Cells( _
23, _
7).Value = _
"x"
Else
TpVtiJlrXGLbE.Cells(23, 7).Value = ""
End If
If _
.OGBaNOeDHMKxYixqlVTsDTshLe.Value = True Then
TpVtiJlrXGLbE.Cells( _
26, _
7).Value = "x"
Else
TpVtiJlrXGLbE.Cells(26, _
7).Value = ""
End If
TpVtiJlrXGLbE.Cells(35, 15).Value = _
.ePRidkUwmcB.Value
TpVtiJlrXGLbE.Cells( _
37, 15).Value = _
.PlBeobachtTB.Value: TpVtiJlrXGLbE.Cells(39, _
15).Value = .PlFachexpTB.Value
End With
FsgxCouSfFNcSHdhLJmUT.Cells(3, _
50).Value = _
Now
If _
rPKdVTmsDOiQIlZnXKLTXCUuwl = _
1 Then
ThisWorkbook.Save
End If
StartGUI.Saved1LBL.Visible = _
True
StartGUI.Saved2LBL.Visible = True
Application.Wait ( _
Now + TimeSerial(0, _
0, _
1))
StartGUI.Saved1LBL.Visible = _
False: StartGUI.Saved2LBL.Visible = False
End Sub
Sub _
txpgvxhtJUoMARxCrcdmaZCX(ZLrQppsGykIVkvfJRXszZb As Worksheet, _
MizxITcSvWjMfcFCLpOunPnmex As Object, RhzplMLPxbiOS As Integer)
Dim CrLxdBkfivng As _
Integer
Dim _
LJHjysaeWJoQvyElwVQ As Long: LJHjysaeWJoQvyElwVQ = fllSYPpCtviZnqagjWpfUcAfoeh( _
ZLrQppsGykIVkvfJRXszZb, _
1)
If LJHjysaeWJoQvyElwVQ < 12 Then
MsgBox "Keine Normelemente für die gewählte Norm hinterlegt.", vbExclamation + vbOKOnly, _
"Keine Normelemente"
Exit _
Sub
End If
MizxITcSvWjMfcFCLpOunPnmex.Clear
For CrLxdBkfivng = 12 To LJHjysaeWJoQvyElwVQ
If _
( _
ZLrQppsGykIVkvfJRXszZb.Cells( _
CrLxdBkfivng, _
4).Value <> _
"" And ZLrQppsGykIVkvfJRXszZb.Cells(CrLxdBkfivng, 5).Value <> "") Or _
ZLrQppsGykIVkvfJRXszZb.Cells( _
CrLxdBkfivng, 4).Value = _
2 Then
MizxITcSvWjMfcFCLpOunPnmex.AddItem
MizxITcSvWjMfcFCLpOunPnmex.List( _
MizxITcSvWjMfcFCLpOunPnmex.ListCount - 1, 0) = _
Trim( _
ZLrQppsGykIVkvfJRXszZb.Cells(CrLxdBkfivng, _
1).Value)
MizxITcSvWjMfcFCLpOunPnmex.List( _
MizxITcSvWjMfcFCLpOunPnmex.ListCount - _
1, 1) = _
ZLrQppsGykIVkvfJRXszZb.Cells(CrLxdBkfivng, 2).Value
MizxITcSvWjMfcFCLpOunPnmex.List(MizxITcSvWjMfcFCLpOunPnmex.ListCount - 1, 2) = _
ZLrQppsGykIVkvfJRXszZb.Cells( _
CrLxdBkfivng, 7).Value
MizxITcSvWjMfcFCLpOunPnmex.List(MizxITcSvWjMfcFCLpOunPnmex.ListCount - _
1, 3) = _
ZLrQppsGykIVkvfJRXszZb.Cells( _
CrLxdBkfivng, _
13).Value
MizxITcSvWjMfcFCLpOunPnmex.List(MizxITcSvWjMfcFCLpOunPnmex.ListCount - 1, 4) = ZLrQppsGykIVkvfJRXszZb.Cells( _
CrLxdBkfivng, _
19).Value
MizxITcSvWjMfcFCLpOunPnmex.List( _
MizxITcSvWjMfcFCLpOunPnmex.ListCount - _
1, 5) = _
EPWtTHstsal(Trim(ZLrQppsGykIVkvfJRXszZb.Cells(CrLxdBkfivng, _
1).Value), RhzplMLPxbiOS): MizxITcSvWjMfcFCLpOunPnmex.List(MizxITcSvWjMfcFCLpOunPnmex.ListCount - _
1, _
6) = CrLxdBkfivng: End If
Next _
CrLxdBkfivng
End Sub
Sub _
aRPYcZRIHrGetyxfehlQjCpXVeCLomJ()
Dim _
PQTuUBYIMwlfYuKWYbaCLpUeQlRt As String
Dim DZPPzDrIEsZTNKEyhn As _
Integer
StartGUI.PlSt1VonTB.Value = _
Format(StartGUI.PlSt1VonTB.Value, _
"hh:mm")
…