Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 87a68d32d1a44149…

MALICIOUS

Office (OOXML)

1005.4 KB Created: 2015-06-15 17:56:18 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2020-12-28
MD5: e03126aee58ca8f3256a60d585260a08 SHA-1: 3454c154777fd9ce8174ab156bfbcd26f7496d1c SHA-256: 87a68d32d1a44149d4bf8378dc220c5ea90a60c0fbda3381918e306e9bce2c9b
246 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment T1204.002 Malicious File T1137.001 Office Application Startup: Office Application

The file is an Excel document containing a Workbook_Open macro that utilizes WScript.Shell and CreateObject to execute VBA code. This code attempts to interact with COM add-ins, suggesting it's designed to download and execute a secondary payload. The presence of a Base64 decoder script URL indicates potential obfuscation and further stages of infection.

Heuristics 9

  • VBA project inside OOXML medium 6 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
            'wsh.Run sPath_setup, windowStyle, waitOnReturn
        Dim process_id As Long: process_id = Shell(setupExePath, vbNormalFocus)
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
                    On Error Resume Next
                    Set objShell = CreateObject("Wscript.Shell")
                    objShell.Run ("https://www.calc4xl.com")
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
                    On Error Resume Next
                    Set objShell = CreateObject("Wscript.Shell")
                    objShell.Run ("https://www.calc4xl.com")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Attribute VB_Customizable = True
Private Sub Workbook_Open()
    Dim allGood As Boolean
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
            Set FSO = CreateObject("scripting.filesystemobject")
        FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
        On Error GoTo LABEL_ERROR
  • Hidden worksheet (hidden) low OOXML_HIDDEN_SHEET
    Excel workbook contains 1 hidden sheet(s) — hidden sheets are commonly used to conceal macro code, staging data, or intermediate payload construction
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL https://www.calc4xl.com In document text (OOXML body / shared strings)
    • https://www.calc4xl.com/en/home/In document text (OOXML body / shared strings)
    • https://www.calc4xl.com/AddInsIn document text (OOXML body / shared strings)
    • https://www.calc4xl.com/en/AddInsIn document text (OOXML body / shared strings)
    • http://www.source-code.biz/snippets/vbasic/Base64Coder.bas.txtIn document text (OOXML body / shared strings)
    • http://www.eclipse.org/legalIn document text (OOXML body / shared strings)
    • http://www.gnu.org/licenses/lgpl.htmlIn document text (OOXML body / shared strings)
    • http://www.gnu.org/licenses/gpl.htmlIn document text (OOXML body / shared strings)
    • http://www.gnu.org/licenses/agpl.htmlIn document text (OOXML body / shared strings)
    • http://www.apache.org/licensesIn document text (OOXML body / shared strings)
    • http://www.opensource.org/licenses/bsd-license.phpIn document text (OOXML body / shared strings)
    • http://www.opensource.org/licenses/MITIn document text (OOXML body / shared strings)
    • http://www.opensource.org/licenses/MIT�In document text (OOXML body / shared strings)
    • http://www.eclipse.org/legal�In document text (OOXML body / shared strings)

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 47539 bytes
SHA-256: a1dc5603c1d021f144404207d94384580208ea9f01d0b1d7b218663855046c09
Preview script
First 1,000 lines of the extracted script
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
Private Sub Workbook_Open()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    Dim c4xlThere As Boolean
    Dim miniAddInThere As Boolean
    Dim c4xlWasDisconnected As Boolean
    Dim miniAddInWasDisconnected As Boolean
    c4xlThere = False
    c4xlConnected = False
    miniAddInThere = False
    miniAddInConnected = False
    Dim mainFolder As String: mainFolder = ""
    Dim hasMiniAddInData As Boolean: hasMiniAddInData = False
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    c4xlThere = True
    c4xlConnected = addIn.Connect
    addIn.Connect = True

LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR_MINIADDIN
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    miniAddInThere = True
    miniAddInConnected = addIn.Connect
    addIn.Connect = (Not c4xlThere)
    
LABEL_ERROR_MINIADDIN:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR_INSTALL
    If c4xlThere Then
        Set addIn = Application.COMAddIns("CALC4XL")
        Set automationObject = addIn.Object
        If automationObject.AreYouThere Then allGood = True
    ElseIf miniAddInThere Then
        Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
        Set automationObject = addIn.Object
        If automationObject.AreYouThere Then allGood = True
    End If
    
LABEL_ERROR_INSTALL:
    On Error GoTo -1
    On Error Resume Next
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
    On Error GoTo LABEL_ERROR
    
    If Not allGood Then 'install miniAddIn
        Dim objShell As Object
        If lang = "de" Then
            If (MsgBox("Diese Datei braucht eine CALC4XL Vollversion (kostenlose Testversion unter www.calc4xl.com) oder ein kleines Mini-AddIn, welches nun automatisch installiert werden kann." & " Soll das Mini-AddIn installiert werden?" & vbCrLf & vbCrLf & "[JA]: Installiert lediglich das benötigte Mini-AddIn." & vbCrLf & vbCrLf & "[NEIN]: Führt Sie zur CALC4XL-Homepage mit der kostenlosen CALC4XL-Testversion.", vbYesNo) = vbYes) Then
                MsgBox "Bitte wählen Sie einen Ordner, in dem die Installationsdateien abgelegt werden können."
            Else
                
                On Error GoTo -1
                On Error Resume Next
                    Set objShell = CreateObject("Wscript.Shell")
                    objShell.Run ("https://www.calc4xl.com")
                On Error GoTo LABEL_ERROR
                
                MsgBox "Die Datei wird bis zur Installation der CALC4XL Vollversion (kostenlose Testversion unter www.calc4xl.com) odes des Mini-AddIns auf schreibgeschützt gesetzt."
                Exit Sub
            End If
        Else
            If (MsgBox("This file needs a CALC4XL full version (free testversion at www.calc4xl.com) or a small Mini-AddIn which may be installed autmatically now." & " Shall the Mini-AddIn be installed?" & vbCrLf & vbCrLf & "[YES]: Will install just the necessary Mini-AddIn." & vbCrLf & vbCrLf & "[NO]: Redirects you to the CALC4XL webpage with the free CALC4XL trial version.", vbYesNo) = vbYes) Then
                MsgBox "Please choose a folder for the installation files."
            Else
            
                On Error GoTo -1
                On Error Resume Next
                    Set objShell = CreateObject("Wscript.Shell")
                    objShell.Run ("https://www.calc4xl.com/en/home/")
                On Error GoTo LABEL_ERROR
                
                MsgBox "This file will be marked as write-protected until a CALC4XL full version (free testversion at www.calc4xl.com) or the Mini-AddIn is installed."
                Exit Sub
            End If
        End If

        'get directory to save install files:
        Dim directory As String
        directory = "ERROR"
        If Application.FileDialog(msoFileDialogFolderPicker).Show = 0 Then
            If lang = "en" Then
                MsgBox "Installation aborted. Therefore the file was marked as write-protected."
            Else
                MsgBox "Installation abgebrochen. Die Datei wird daher auf schreibgeschützt gesetzt."
            End If
            Exit Sub
        End If
        directory = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
        
        'main folder:
        mainFolder = directory & Application.PathSeparator & "miniAddInSetup" ' & Application.PathSeparator
        'Delete folder if exisitng (otherwise copy functon will ask if copy ok
        '   Alternatively but did not always work:
        '   On Error Resume Next
        '   Kill DefPath & "*.*"
        '   RmDir "C:\Users\Andy\Desktop\testUnzipMiniAddIn"
        '   On Error GoTo 0
        Dim objFSO As Object
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        On Error GoTo -1
        On Error Resume Next 'if folder does not exist; alternatively look if folder exists
        objFSO.DeleteFolder (mainFolder) ' '\' is not allowed to be in the end of the path
        MkDir mainFolder ' '\' is allowed but not necessary
        Set objFSO = Nothing
        On Error GoTo LABEL_ERROR
        mainFolder = mainFolder & Application.PathSeparator
        
        'get setup.exe-path from customXML:
        Dim xmlPart As CustomXMLPart
        Set xmlPart = Application.ThisWorkbook.CustomXMLParts.SelectByNamespace("miniCBDAddIn").Item(1)
        hasMiniAddInData = True
        Dim setupExePath As String: setupExePath = mainFolder & xmlPart.SelectSingleNode("//ns0:file/ns0:sPath").Text + ".exe"

        'get zip-file from customXML:
        Dim file_str As String: file_str = xmlPart.SelectSingleNode("//ns0:file/ns0:data").Text
        Dim sPath_setup As String: sPath_setup = mainFolder & "CALC4XLMiniAddIn_1.zip"
        Open sPath_setup For Binary Access Write As #1
        lWritePos = 1
        Put #1, lWritePos, Base64Decode(file_str)
        Close #1
        
        'unzip file -> needs variant as parameters!
        Dim FileNameFolder As Variant: FileNameFolder = mainFolder
        Dim Fname As Variant: Fname = sPath_setup
        Dim oApp As Object
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items 'needs Variant as parameters!
        'If you want to extract only one file you can use this:
        'oApp.Namespace(FileNameFolder).CopyHere _
         'oApp.Namespace(Fname).items.Item("test.txt")
        On Error GoTo -1
        On Error Resume Next
        Dim FSO As Object
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
        On Error GoTo LABEL_ERROR
        
        'start setup.exe:
        On Error GoTo -1
        On Error GoTo LABEL_ERROR_EXECUTION
        'Alternatively:
        'Dim wsh As Object
        'Set wsh = VBA.CreateObject("WScript.Shell")
        'Dim waitOnReturn As Boolean: waitOnReturn = True
        'Dim windowStyle As Integer: windowStyle = 1
        'wsh.Run sPath_setup, windowStyle, waitOnReturn
        Dim process_id As Long: process_id = Shell(setupExePath, vbNormalFocus)
        
        'CLOSE file and
        '   if success resatrt
        '   if not success stay closed
        On Error GoTo -1
        On Error Resume Next
        If lang = "de" Then
            If (MsgBox("Sofern das AddIn installiert wurde, können Sie Excel schließen und die Datei in vollem Umfang erneut öffnen. Danke." & vbCrLf & vbCrLf & "Die gesamte Excel-Anwendung muss neu gestartet werden. Excel schließen?", vbYesNo) = vbYes) Then
                Application.Quit
                Exit Sub
            Else
                MsgBox "Bis zum Schließen und erneuten Starten der Excel-Anwendung wird die Datei auf schreibgeschützt gesetzt."
                'ThisWorkbook.Close (False)
                Exit Sub
            End If
        Else
            If (MsgBox("If the AddIn was installed, please close Excel and open the file again to use it with all functionalities. Thank you." & vbCrLf & vbCrLf & "The whole Excel application has to be restarted. Close Excel?", vbYesNo) = vbYes) Then
                Application.Quit
                Exit Sub
            Else
               MsgBox "Until you have closed and reopened Excel, the file is marked as write-protected."
                'ThisWorkbook.Close (False)
                Exit Sub
            End If
        End If
        
    'now done in wbOpen-event of miniAddIn:
    'Else
        'On Error GoTo -1
        'On Error Resume Next
        'If (Not c4xlThere And miniAddInThere) Then
        '    automationObject.CBD_hasCALC4XLModulesHint
        'End If
    End If
    
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        'Dim lang As String
        'lang = "en"
        'lang = Range("calc4xl_language").value
        If lang = "de" Then
            If hasMiniAddInData Then
                MsgBox "Nicht in der Lage, das Mini-AddIn automatisch zu laden. Bitte laden Sie es unter www.calc4xl.com/AddIns herunter, entzippen Sie es und starten mittels Doppelklick auf Setup." & vbCrLf & vbCrLf & "Alternativ können Sie auch eine CALC4XL Vollversion kostenlos unter www.calc4xl.com herunterladen. Die Datei wird mit aktiver und abgelaufener Lizenz funktionieren. Danke." & vbCrLf & vbCrLf & "Die Datei wurde auf schreibgeschützt gesetzt."
            Else
                MsgBox "Diese Datei wurde nicht für Nutzer ohne CALC4XL Vollversion vorbereitet. Sie brauchen eine CALC4XL Vollversion oder Fragen Sie den Absender dieser Datei nach einer für Nutzer ohne CALC4XL vorbereiteten Version. Danke. Die Datei wurde auf schreibgeschützt gesetzt."
            End If
            'try to open webpage:
            Set objShell = CreateObject("Wscript.Shell")
            objShell.Run ("https://www.calc4xl.com/AddIns")
        Else
            If hasMiniAddInData Then
                MsgBox "Not able to load the mini AddIn automatically. Please go to www.calc4xl.com/en/AddIns to download the AddIn manually. Afterwards please extract the file and start the installation by double-click on 'Setup'." & vbCrLf & vbCrLf & "Alternatively you can install the CALC4XL full verion at www.calc4xl.com. This file will be working with active and expired CALC4XL license." & vbCrLf & vbCrLf & "The file was marked as write-protected."
            Else
                MsgBox "This file has not been prepared to be used by users without CALC4XL full version. You need a CALC4XL full version or ask the sender of this file for a version which is prepared for users without CALC4XL. Thank you. The file was marked as write-protected."
            End If
            'try to open webpage:
            Set objShell = CreateObject("Wscript.Shell")
            objShell.Run ("https://www.calc4xl.com/en/AddIns")
        End If
        'ThisWorkbook.Close (False)
    End If
    Exit Sub
    
LABEL_ERROR_EXECUTION:
    On Error GoTo -1
    On Error Resume Next
    If lang = "de" Then
        MsgBox "Nicht in der Lage, die Installationsdatei autmatisch zu laden. Bitte starten Sie '" & setupExePath & "' manuell! Bis dahin wird die Datei auf schreibgeschützt gesetzt."
    Else
        MsgBox "Not able to install automatically. Please start '" & setupExePath & "' manually! Before then this file will be marked as write-protected."
    End If
    On Error GoTo LABEL_ERROR_FOLDER
    Shell "explorer.exe" & " " & mainFolder, vbNormalFocus
    'ThisWorkbook.Close (False)
    Exit Sub
    
LABEL_ERROR_FOLDER:
    On Error GoTo -1
    On Error Resume Next
    If lang = "de" Then
        MsgBox "Sie finden die Setup-Datei unter '" & mainFolder & "'. Bis zur Installation wird die Datei auf schreibgeschützt gesetzt."
    Else
        MsgBox "You will find the setup-file at '" & mainFolder & "'. Before installation this file will be marked as write-protected."
    End If
    'ThisWorkbook.Close (False)
    Exit Sub
    
End Sub




Attribute VB_Name = "Sheet3"
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
Option Explicit
Dim mode As String
Public StrPassword As String
Public targetFlag As Integer


Private Sub CmdClearSheet_Click()
    'not used as CmdClearSheet is Visible=false at the moment!
    'look to old CBDs if you want to reintroduce it but do by C# and namedRanges!
    MsgBox "CmdClearSheet_Click(): Not implemented yet."
End Sub

Private Sub CmdClearSheet_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

End Sub

Sub cmdCopySheet_Click()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_copySheet
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If
End Sub


Private Sub cmdPrint_Click()
    'not used at the moment or?
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_allgemein_cmdPrint_Click
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If

End Sub


Sub cmdPartPicture_Click()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_partPicture_click
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If

End Sub

'NEU 2016_02_05 NEU NEU NEU NEU NEU NEU NEU NEU NEU NEU
'NICHT ÜBERSETZEN IN C#, da es neu umgesetzt wird
Sub orderSection24_Click() 'IGNORE!!!!!!!
    'maybe do not put to C# as would be probably slower.

    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    If Not automationObject.CBD_licenseOk Then Exit Sub
    If Not automationObject.CBD_hasRightsOnWs(Application.ActiveSheet) Then Exit Sub
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
        Exit Sub
    End If

On Error GoTo LABEL_ERROR_2 'ok as afer On Error Resume Next is On Error Goto Label allowed

Dim actRow As Integer
Dim rightRow As Integer
Dim AN90_setup_str As String
Dim foundRightRow As Boolean
Dim noMessage As Boolean
Dim somethingSorted As Boolean
Dim screenUpdateWasOn As Boolean
screenUpdateWasOn = Application.ScreenUpdating
Dim eventsWereOn As Boolean
eventsWereOn = Application.EnableEvents


noMessage = False
somethingSorted = False

'PasswordBreaker

Application.ScreenUpdating = False
Application.EnableEvents = True 'have to be true so CALC4Xl can update cell-positions

Range("calc4xlHintCell").value = "proc_sorting"

AN90_setup_str = "A90:AT90"
For actRow = 66 To 89
    If Range("A" & actRow).value <> (actRow - 65) Then
        somethingSorted = True
        Range("A" & actRow & ":AT" & actRow).Cut Range(AN90_setup_str)
        If Range("calc4xlHintCell").value = "proc_break" Then
            noMessage = True
            GoTo line_forceBreak
        End If
        foundRightRow = False
        For rightRow = 66 To 89
            If Range("A" & rightRow).value = (actRow - 65) Then
                Range("A" & rightRow & ":AT" & rightRow).Cut Range("A" & actRow & ":AT" & actRow)
                If Range("calc4xlHintCell").value = "proc_break" Then
                    Range("A" & actRow & ":AT" & actRow).Cut Range("A" & rightRow & ":AT" & rightRow)
                    noMessage = True
                    GoTo line_forceBreak
                End If
                Range(AN90_setup_str).Cut Range("A" & rightRow & ":AT" & rightRow)
                If Range("calc4xlHintCell").value = "proc_break" Then
                    Range("A" & rightRow & ":AT" & rightRow).Cut Range(AN90_setup_str)
                    Range("A" & actRow & ":AT" & actRow).Cut Range("A" & rightRow & ":AT" & rightRow)
                    noMessage = True
                    GoTo line_forceBreak
                End If
                foundRightRow = True
                Exit For
            End If
        Next
        If Not foundRightRow Then
line_forceBreak:
            Range(AN90_setup_str).Cut Range("A" & actRow & ":AT" & actRow)
            Range("calc4xlHintCell").value = "proc_none"
            'Application.ScreenUpdating = True
            If Not noMessage Then
                If Range("calc4xl_language").value = "de" Then ' ok that fails if calc4xl_language not exsiitng as then worksheet possibly so changed that sorting will not working properly anyway
                    MsgBox ("Keine Zeile mit Ordnungsnummer " & (actRow - 65) & " gefunden! Bitte geben Sie alle Nummern von 1 bis 24 an (ohne Doppelungen). Das Sortieren wird abgebrochen!")
                Else
                    MsgBox ("Was not able to find line for row " & (actRow - 65) & "! Please fill in numbers 1 to 24 (no doubling). Abort sorting!")
                End If
            End If
            Application.ScreenUpdating = screenUpdateWasOn
            Application.EnableEvents = eventsWereOn
            Exit Sub
        End If
    End If
Next

Range("calc4xlHintCell").value = "proc_none"
'Application.ScreenUpdating = True
Application.ScreenUpdating = screenUpdateWasOn

If Not somethingSorted Then
    If Range("calc4xl_language").value = "de" Then ' ok that fails if calc4xl_language not exsiitng as then worksheet possibly so changed that sorting will not working properly anyway
        MsgBox ("Schreiben Sie unterhalb dieses Schalters die Ornungsnummern 1 bis max. 24 (ohne Doppelungen) und drücken Sie auf 'Sort', dann werden die Zeilen entsprechend Ihrer Vorgabe neu sortiert.")
    Else
        MsgBox ("Fill the column below this button with the order-numbers 1 to maximum 24 (no doubling) und press 'Sort'. Then the lines will be reordered according to your numbers.")
    End If
End If

Application.ScreenUpdating = screenUpdateWasOn
Application.EnableEvents = eventsWereOn

Exit Sub

LABEL_ERROR_2:
    On Error GoTo -1
    On Error Resume Next
    
    Application.ScreenUpdating = screenUpdateWasOn
    Application.EnableEvents = eventsWereOn

    Dim lang1 As String 'do not define double as already defined above; maybe define once in the top of sub
    lang1 = "en"
    lang1 = Range("calc4xl_language").value
    If lang1 = "de" Then
        MsgBox "Fehler beim Ausführen des Sortierbuttons. Melden Sie sich unter info@calc4xl.com für Hilfe. Danke." & vbCrLf & vbCrLf & "Die Datei wird nun geschlossen."
    Else
        MsgBox "Error in processing sorting. Please contact info@calc4xl.com for help. Thanks." & vbCrLf & vbCrLf & "The file will be closed now."
    End If
    ThisWorkbook.Close (False)
    Exit Sub


End Sub
'ENDE NEU 2016_02_05 NEU NEU NEU NEU NEU NEU NEU NEU NEU NEU

Sub SpinButton1_SpinDown()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_spinButton1_spinDown
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If
End Sub

Sub SpinButton1_SpinUp()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_spinButton1_spinUp
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If
End Sub

Sub SpinButton2_SpinDown()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_spinButton2_spinDown
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If
End Sub
Sub isChangeLegal() 'not used at the moment as subroutines check it by it's own => delete in subs and put this function
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If

LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        ThisWorkbook.Close (False)
    End If
    
End Sub

Sub SpinButton2_SpinUp()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_spinButton2_spinUp
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If
End Sub

Sub SpinButton3_SpinDown()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_spinButton3_spinDown
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If
End Sub

Sub SpinButton3_SpinUp()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
        
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_spinButton3_spinUp
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If
End Sub

Sub SpinButton4_SpinDown()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
            
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_spinButton4_spinDown
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If
End Sub

Sub SpinButton4_SpinUp()
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    automationObject.CBD_spinButton4_spinUp
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
        End If
        'ThisWorkbook.Close (False)
    End If
End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    Call automationObject.CBD_worksheet_selectionChange(Target)
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
'        Dim lang As String
'        lang = "en"
'        lang = Range("calc4xl_language").value
'        If lang = "de" Then
'            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com"
'        Else
'            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com"
'        End If
'        'ThisWorkbook.Close (False)
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'isChangeLegal '-> all done now by own code ;-)
    Dim allGood As Boolean
    allGood = False
    Dim addIn As COMAddIn
    Dim automationObject As Object
    
    On Error GoTo LABEL_ERROR_CALC4XL
    Set addIn = Application.COMAddIns("CALC4XL")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
    
LABEL_ERROR_CALC4XL:
    On Error GoTo -1
    On Error GoTo LABEL_ERROR
If Not allGood Then
    Set addIn = Application.COMAddIns("CALC4XL_CBD_miniAddIn")
    Set automationObject = addIn.Object
    If automationObject.AreYouThere Then allGood = True
End If
    Call automationObject.CBD_worksheet_change(Target)
    
LABEL_ERROR:
    On Error GoTo -1
    On Error Resume Next
    If Not allGood Then
        Dim lang As String
        lang = "en"
        lang = Range("calc4xl_language").value
        If lang = "de" Then
            MsgBox "Ändern Sie diese Datei nicht ohne CALC4XL!" & vbCrLf & vbCrLf & "Weitere Informationen und eine kostenlose Testversion finden Sie unter www.calc4xl.com oder schreiben Sie an info@calc4xl.com" & vbCrLf & vbCrLf & "Diese Datei wird nun geschlossen."
        Else
            MsgBox "Do not change this file without CALC4XL!" & vbCrLf & vbCrLf & "You will find more information and a free testversion at www.calc4xl.com or write to info@calc4xl.com" & vbCrLf & vbCrLf & "This file will be closed now."
        End If
        ThisWorkbook.Close (False)
    End If

End Sub



Sub FormatPage()
    'not explicitly used at the moment!
    'look to old CBDs if you want to reintroduce it
    'hint: There exists already a C#-Code formatPage()
    MsgBox "FormatPage(): Not implemented yet."
End Sub

Private Sub PasswordBreaker() '-> löschen!
    'not used at the moment!
    'look to old CBDs if you want to reintroduce it but do by C# and namedRanges!
    'or better use C# functions of getting rights of workbook and worksheets
    MsgBox "PasswordBreaker(): Not implemented."
End Sub


Attribute VB_Name = "Tabelle1"
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

Attribute VB_Name = "Sheet97"
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
Dim sheetName As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    On Error GoTo LABEL_ERROR_SelectionChange
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 111104 bytes
SHA-256: 8fee99f64bd9146a058c2bd11c94699083617b279ec9bbbd04c87c87ff7834bf

Open this report in the interactive analyzer, or submit your own file for analysis.