Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "LatexForm"
Attribute VB_Base = "0{EE134C5A-2F6C-4F0D-AEE2-DCB9B5DC0A20}{D10DD706-AD5A-423A-964A-C96E0275606B}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Dim RegPath As String
    
Dim LaTexEngineList As Variant
Dim LaTexEngineDisplayList As Variant
Dim UsePDFList As Variant

'Dim NumberOfTemplates As Long
Dim TemplateSortedListString As String
Dim TemplateSortedList() As String
Dim TemplateNameSortedListString As String

Dim FormHeightWidthSet As Boolean

Dim theAppEventHandler As New AppEventHandler

Sub InitializeApp()
    Set theAppEventHandler.App = Application
    
    AddMenuItem "New Latex display...", "NewLatexEquation", 18 '226
    AddMenuItem "Edit Latex display...", "EditLatexEquation", 37
    AddMenuItem "Regenerate selection...", "RegenerateSelectedDisplaysNoChange", 19
    AddMenuItem "Vectorize selection...", "ConvertToEMF", 153
    AddMenuItem "Rasterize selection...", "ConvertToPNG", 931
    AddMenuItem "Settings...", "LoadSetTempForm", 548
    AddMenuItem "Insert vector file...", "RibbonInsertVectorGraphicsFile", 23
    
End Sub

Sub AddMenuItem(itemText As String, itemCommand As String, itemFaceId As Long)
    ' Check if we have already added the menu item
    Dim initialized As Boolean
    Dim bef As Integer
    initialized = False
    bef = 1
    Dim Menu As CommandBars
    Set Menu = Application.CommandBars
    For i = 1 To Menu("Insert").Controls.count
        With Menu("Insert").Controls(i)
            If .Caption = itemText Then
                initialized = True
                Exit For
            ElseIf InStr(.Caption, "Dia&gram") Then
                bef = i
            End If
        End With
    Next
    
    ' Create the menu choice.
    If Not initialized Then
        Dim NewControl As CommandBarControl
        Set NewControl = Menu("Insert").Controls.Add _
                              (Type:=msoControlButton, _
                               before:=bef, _
                               Id:=itemFaceId)
        NewControl.Caption = itemText
        NewControl.OnAction = itemCommand
        NewControl.Style = msoButton
    End If
End Sub

Sub UnInitializeApp()
    
    RemoveMenuItem "New Latex display..."
    RemoveMenuItem "Edit Latex display..."
    RemoveMenuItem "Regenerate selection..."
    RemoveMenuItem "Vectorize selection..."
    RemoveMenuItem "Rasterize selection..."
    RemoveMenuItem "Settings..."
    RemoveMenuItem "Insert vector file..."
    ' Clean up older versions
    RemoveMenuItem "Regenerate selected displays..."
    RemoveMenuItem "Convert to EMF..."
    RemoveMenuItem "Convert to PNG..."

    
End Sub

Sub RemoveMenuItem(itemText As String)
    Dim Menu As CommandBars
    Set Menu = Application.CommandBars
    For i = 1 To Menu("Insert").Controls.count
        If Menu("Insert").Controls(i).Caption = itemText Then
            Menu("Insert").Controls(i).Delete
            Exit For
        End If
    Next
    

End Sub


Private Sub ButtonCancel_Click()
    Unload LatexForm
    ' LatexForm.Hide
End Sub


Private Function IsPathWritable(TempPath As String) As Boolean
    FilePrefix = GetFilePrefix()
    
    Dim FName As String
    Dim FHdl As Integer
    FName = TempPath & FilePrefix & ".tmp"
    On Error GoTo TempFolderNotWritable
    FHdl = FreeFile()
    Open FName For Output Access Write As FHdl
    Print #FHdl, "TESTWRITE"
    Close FHdl
    IsPathWritable = True
    Kill FName
    
    On Error GoTo 0
    
    Exit Function

TempFolderNotWritable:
    IsPathWritable = False
End Function

Private Sub WriteLaTeX2File(TempPath As String, FilePrefix As String)
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(TempPath & FilePrefix & ".png") Then
        fs.DeleteFile TempPath + FilePrefix + "*.*" 'Make sure we don't keep old files
    End If
    RegPath = "Software\IguanaTex"
    Dim UseUTF8 As Boolean
    UseUTF8 = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "UseUTF8", True)
    
    If UseUTF8 = False Then
        Set f = fs.CreateTextFile(TempPath + FilePrefix + ".tex", True)
        f.Write TextBox1.Text
        f.Close
    Else
        Dim BinaryStream As Object
        Set BinaryStream = CreateObject("ADODB.stream")
        BinaryStream.Type = 1
        BinaryStream.Open
        Dim adodbStream  As Object
        Set adodbStream = CreateObject("ADODB.Stream")
        With adodbStream
            .Type = 2 'Stream type
            .Charset = "utf-8"
            .Open
            .WriteText TextBox1.Text
            '.SaveToFile TempPath & FilePrefix & ".tex", 2 'Save binary data To disk; problem: this includes a BOM
            ' Workaround to avoid BOM in file:
            .Position = 3 'skip BOM
            .CopyTo BinaryStream
            .Flush
            .Close
        End With
        BinaryStream.SaveToFile TempPath & FilePrefix & ".tex", 2 'Save binary data To disk
        BinaryStream.Flush
        BinaryStream.Close
    End If
    Set fs = Nothing
End Sub

Sub ButtonRun_Click()
    Dim TempPath As String
    'TempPath = GetTempPath()
    If Right(TextBoxTempFolder.Text, 1) <> "\" Then
        TextBoxTempFolder.Text = TextBoxTempFolder.Text & "\"
    End If
    TempPath = TextBoxTempFolder.Text
    
    If Left(TempPath, 1) = "." Then
        Dim sPath As String
        sPath = ActivePresentation.path
        If Len(sPath) > 0 Then
            If Right(sPath, 1) <> "\" Then
                sPath = sPath & "\"
            End If
            TempPath = sPath & TempPath
        Else
            MsgBox "You need to have saved your presentation once to use a relative path."
            Exit Sub
        End If
    End If
    
    Dim FilePrefix As String
    FilePrefix = GetFilePrefix()
    
    Dim debugMode As Boolean
    debugMode = checkboxDebug.Value
    
    ' Read settings
    RegPath = "Software\IguanaTex"
    LATEXENGINEID = ComboBoxLaTexEngine.ListIndex
    tex2pdf_command = LaTexEngineList(LATEXENGINEID)
    Dim TeXExePath As String
    TeXExePath = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "TeXExePath", "")
    TeXExeExt = ""
    If TeXExePath <> "" Then TeXExeExt = ".exe"
    Dim UsePDF As Boolean
    UsePDF = UsePDFList(LATEXENGINEID)
    
    Dim UseEMF As Boolean
    BitmapVector = ComboBoxBitmapVector.ListIndex
    If BitmapVector = 0 Then
        UseEMF = False
    Else
        UseEMF = True
    End If
    'UseEMF = CheckBoxEMF.Value
    Dim OutputType As String
    
    Dim TimeOutTimeString As String
    Dim TimeOutTime As Long
    TimeOutTimeString = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "TimeOutTime", "20") ' Wait 20 seconds for the processes to complete
    TimeOutTime = val(TimeOutTimeString) * 1000
    
    Dim OutputDpiString As String
    OutputDpiString = TextBoxLocalDPI.Text
    Dim OutputDpi As Long
    OutputDpi = val(OutputDpiString)
    
    ' Read current dpi in: this will be used when rescaling
    dpi = 96 'lDotsPerInch ' I'm not convinced that this is the right thing to do, so for now I stop trying to take dpi into account
    default_screen_dpi = 96
    Dim VectorScalingX As Single, VectorScalingY As Single, BitmapScalingX As Single, BitmapScalingY As Single
    VectorScalingX = dpi / default_screen_dpi * val(GetRegistryValue(HKEY_CURRENT_USER, RegPath, "VectorScalingX", "1"))
    VectorScalingY = dpi / default_screen_dpi * val(GetRegistryValue(HKEY_CURRENT_USER, RegPath, "VectorScalingY", "1"))
    BitmapScalingX = val(GetRegistryValue(HKEY_CURRENT_USER, RegPath, "BitmapScalingX", "1"))
    BitmapScalingY = val(GetRegistryValue(HKEY_CURRENT_USER, RegPath, "BitmapScalingY", "1"))
        
    ' Test if path writable
    If Not IsPathWritable(TempPath) Then
        MsgBox "The temporary folder " & TempPath & " appears not to be writable."
        Exit Sub
    End If
    
    
    ' Write latex to a temp file
    Call WriteLaTeX2File(TempPath, FilePrefix)
    
    
    ' Run latex
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Set fs = CreateObject("Scripting.FileSystemObject")
    Dim LogFile As Object
    FrameProcess.Visible = True
    
    If UseEMF = True Then ' Use TeX2img to generate an EMF file
        tex2img_command = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "TeX2img Command", "%USERPROFILE%\Downloads\TeX2img\TeX2imgc.exe")
        LabelProcess.Caption = "LaTeX to EMF..."
        FrameProcess.Repaint
        RetVal& = Execute("""" & tex2img_command & """ --latex " + tex2pdf_command + " --preview- """ + FilePrefix + ".tex"" """ + FilePrefix + ".emf""", TempPath, debugMode, TimeOutTime)
        If (RetVal& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".emf")) Then
            ' Error in Latex code
            ' Read log file and show it to the user
            If fs.FileExists(TempPath & FilePrefix & ".log") Then
                Set LogFile = fs.OpenTextFile(TempPath + FilePrefix + ".log", ForReading)
                LogFileViewer.TextBox1.Text = LogFile.ReadAll
                LogFile.Close
                LogFileViewer.TextBox1.ScrollBars = fmScrollBarsBoth
                LogFileViewer.Show 1
            Else
                MsgBox "TeX2img did not return in " & TimeOutTimeString & " seconds and may have hung." _
                & vbNewLine & "You should have run TeX2img once outside IguanaTex to make sure its path are set correctly." _
                & vbNewLine & "Please make sure your code compiles outside IguanaTex."
            End If
            FrameProcess.Visible = False
            Exit Sub
        End If
        FinalFilename = FilePrefix & ".emf"
        OutputType = "EMF"
    Else
        If UsePDF = True Then ' pdf to png route
            gs_command = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "GS Command", "C:\Program Files (x86)\gs\gs9.15\bin\gswin32c.exe")
            IMconv = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "IMconv", "C:\Program Files\ImageMagick\convert.exe")
            
            If tex2pdf_command = "platex" Then
                OutputExt = ".dvi"
                LabelProcess.Caption = "LaTeX to DVI..."
            Else
                OutputExt = ".pdf"
                LabelProcess.Caption = "LaTeX to PDF..."
            End If
            FrameProcess.Repaint
            
            RetVal& = Execute("""" & TeXExePath & tex2pdf_command & TeXExeExt & """ -shell-escape -interaction=batchmode """ + FilePrefix + ".tex""", TempPath, debugMode, TimeOutTime)
            
            If (RetVal& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & OutputExt)) Then
                ' Error in Latex code
                ' Read log file and show it to the user
                If fs.FileExists(TempPath & FilePrefix & ".log") Then
                    Set LogFile = fs.OpenTextFile(TempPath + FilePrefix + ".log", ForReading)
                    LogFileViewer.TextBox1.Text = LogFile.ReadAll
                    LogFile.Close
                    LogFileViewer.TextBox1.ScrollBars = fmScrollBarsBoth
                    LogFileViewer.Show 1
                Else
                    MsgBox tex2pdf_command & " did not return in " & TimeOutTimeString & " seconds and may have hung." _
                    & vbNewLine & "Please make sure your code compiles outside IguanaTex." _
                    & vbNewLine & "You may also try generating in Debug mode, as it will let you know if any font/package is missing"
                End If
                FrameProcess.Visible = False
                Exit Sub
            End If
            
            If tex2pdf_command = "platex" Then
                LabelProcess.Caption = "DVI to PDF..."
                FrameProcess.Repaint
                ' platex actually outputs a DVI file, which we need to convert to PDF (we could go the EPS route, but this blends easier with IguanaTex's existing code)
                RetValConv& = Execute("""" & TeXExePath & "dvipdfmx" & TeXExeExt & """ -o """ + FilePrefix + ".pdf"" """ & FilePrefix & ".dvi""", TempPath, debugMode, TimeOutTime)
                If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".pdf")) Then
                    ' Error in DVI to PDF conversion
                    MsgBox "Error while using dvipdm to convert from DVI to PDF."
                    FrameProcess.Visible = False
                    Exit Sub
                End If
            End If
            
            LabelProcess.Caption = "PDF to PNG..."
            FrameProcess.Repaint
            ' Output Bounding Box to file and read back in the appropriate information
            RetValConv& = Execute("cmd /C """ & gs_command & """ -q -dBATCH -dNOPAUSE -sDEVICE=bbox " & FilePrefix & ".pdf 2> " & FilePrefix & ".bbx", TempPath, debugMode, TimeOutTime)
            If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".bbx")) Then
                ' Error in bounding box computation
                MsgBox "Error while using Ghostscript to compute the bounding box. Is your path correct?"
                FrameProcess.Visible = False
                Exit Sub
            End If
            Dim BBString As String
            BBString = BoundingBoxString(TempPath + FilePrefix + ".bbx")
            
            ' Convert PDF to PNG
            If checkboxTransp.Value = True Then
                PdfPngDevice = "-sDEVICE=pngalpha"
            Else
                PdfPngDevice = "-sDEVICE=png16m"
            End If
            RetValConv& = Execute("""" & gs_command & """ -q -dBATCH -dNOPAUSE " & PdfPngDevice & " -r" & OutputDpiString & " -sOutputFile=""" & FilePrefix & "_tmp.png""" & BBString & " -f """ & TempPath & FilePrefix & ".pdf""", TempPath, debugMode, TimeOutTime)
            If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & "_tmp.png")) Then
                ' Error in PDF to PNG conversion
                MsgBox "Error while using Ghostscript to convert from PDF to PNG. Is your path correct?"
                FrameProcess.Visible = False
                Exit Sub
            End If
            ' Unfortunately, the resulting file has a metadata DPI of OutputDpi (=1200), not the default screen one (usually 96),
            ' so there is a discrepancy with the dvipng output, which is always 96 (independent of the screen, actually).
            ' The only workaround I have found so far is to use Imagemagick's convert to change the DPI (but not the pixel size!)
            ' Execute """" & IMconv & """ -units PixelsPerInch """ & FilePrefix & "_tmp.png"" -density " & CStr(dpi) & " """ & FilePrefix & ".png""", TempPath, debugMode
            RetValConv& = Execute("""" & IMconv & """ -units PixelsPerInch """ & FilePrefix & "_tmp.png"" -density " & CStr(default_screen_dpi) & " """ & FilePrefix & ".png""", TempPath, debugMode, TimeOutTime)
            If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".png")) Then
                ' Error in PDF to PNG conversion
                MsgBox "Error while using ImageMagick to change the PNG DPI. Is your path correct?" _
                & vbNewLine & "The full path is needed to avoid conflict with Windows's built-in convert.exe."
                FrameProcess.Visible = False
                Exit Sub
            End If
            
            ' 'I considered using ImageMagick's convert, but it's extremely slow, and uses ghostscript in the backend anyway
            'PdfPngSwitches = "-density 1200 -trim -transparent white -antialias +repage"
            'Execute IMconv & " " & PdfPngSwitches & " """ & FilePrefix & ".pdf"" """ & FilePrefix & ".png""", TempPath, debugMode
            
        Else
        ' dvi to png route
            LabelProcess.Caption = "LaTeX to DVI..."
            FrameProcess.Repaint
            RetVal& = Execute("""" & TeXExePath & "pdflatex" & TeXExeExt & """ -shell-escape -output-format dvi -interaction=batchmode """ + FilePrefix + ".tex""", TempPath, debugMode, TimeOutTime)
            If (RetVal& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".dvi")) Then
                ' Error in Latex code
                ' Read log file and show it to the user
                If fs.FileExists(TempPath & FilePrefix & ".log") Then
                    Set LogFile = fs.OpenTextFile(TempPath + FilePrefix + ".log", ForReading)
                    LogFileViewer.TextBox1.Text = LogFile.ReadAll
                    LogFile.Close
                    LogFileViewer.TextBox1.ScrollBars = fmScrollBarsBoth
                    LogFileViewer.Show 1
                Else
                    MsgBox "latex did not return in " & TimeOutTimeString & " seconds and may have hung." _
                    & vbNewLine & "Please make sure your code compiles outside IguanaTex." _
                    & vbNewLine & "You may also try generating in Debug mode, as it will let you know if any font/package is missing."
                End If
                FrameProcess.Visible = False
                Exit Sub
            End If
            LabelProcess.Caption = "DVI to PNG..."
            FrameProcess.Repaint
            DviPngSwitches = "-q -D " & OutputDpiString & " -T tight"  ' monitor is 96 dpi or higher; we use OutputDpi (=1200 by default) dpi to get a crisper display, and rescale later on for new displays to match the point size
            If checkboxTransp.Value = True Then
                DviPngSwitches = DviPngSwitches & " -bg Transparent"
            End If
            ' If the user created a .png by using the standalone class with convert, we use that, else we use dvipng
            If Not fs.FileExists(TempPath & FilePrefix & ".png") Then
                RetValConv& = Execute("""" & TeXExePath & "dvipng" & TeXExeExt & """ " & DviPngSwitches & " -o """ & FilePrefix & ".png"" """ & FilePrefix & ".dvi""", TempPath, debugMode, TimeOutTime)
                If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".png")) Then
                    MsgBox "dvipng failed, or did not return in " & TimeOutTimeString & " seconds and may have hung." _
                    & vbNewLine & "You may want to try compiling using the PDF->PNG option." _
                    & vbNewLine & "You may also try generating in Debug mode, as it will let you know if any font is missing."
                    FrameProcess.Visible = False
                    Exit Sub
                End If
            End If
        End If
        OutputType = "PNG"
        FinalFilename = FilePrefix & ".png"
    End If
    ' Latex run successful.
    
    
    ' Now we prepare the insertion of the image
    LabelProcess.Caption = "Insert image..."
    FrameProcess.Repaint
    
    ' If we are in Edit mode, store parameters of old image
    Dim PosX As Single
    Dim PosY As Single
    Dim Sel As Selection
    Set Sel = Application.ActiveWindow.Selection
    Dim oldshape As Shape
    Dim oldshapeIsEMF As Boolean
    Dim s As Shape
    IsInGroup = False
    If ButtonRun.Caption = "ReGenerate" Then
        If Sel.ShapeRange.Type = msoGroup And Sel.HasChildShapeRange Then
            ' Old image is part of a group
            Set oldshape = Sel.ChildShapeRange(1)
            IsInGroup = True
            Dim arr() As Variant ' gather all shapes to be regrouped later on
            j = 0
            For Each s In Sel.ShapeRange.GroupItems
                If s.name <> oldshape.name Then
                    j = j + 1
                    ReDim Preserve arr(1 To j)
                    arr(j) = s.name
                End If
            Next
            
            ' Store the group's animation and Zorder info in a dummy object tmpGroup
            Dim oldGroup As Shape
            Set oldGroup = Sel.ShapeRange(1)
            Dim tmpGroup As Shape
            Set tmpGroup = ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeDiamond, 1, 1, 1, 1)
            MoveAnimation oldGroup, tmpGroup
            MatchZOrder oldGroup, tmpGroup
            
            ' Tag all elements in the group with their hierarchy level and their name or group name
            Dim MaxGroupLevel As Long
            MaxGroupLevel = TagGroupHierarchy(arr, oldshape.name)
            
        Else
            Set oldshape = Sel.ShapeRange(1)
        End If
        PosX = oldshape.Left
        PosY = oldshape.Top
        oldshapeIsEMF = False
        If oldshape.Tags.Item("BitmapVector") <> "" Then
            If oldshape.Tags.Item("BitmapVector") = 1 Then
                oldshapeIsEMF = True
            End If
        End If
    Else
        PosX = 200
        PosY = 200
    End If
            
    ' Get scaling factors
    Dim isTexpoint As Boolean
    Dim tScaleWidth As Single, tScaleHeight As Single
    MagicScalingFactorEMF = 1 ' 1 / 100 ' Magical scaling factor for EMF
    MagicScalingFactorPNG = default_screen_dpi / OutputDpi
    If UseEMF Then
        MagicScalingFactor = MagicScalingFactorEMF
    Else
        MagicScalingFactor = MagicScalingFactorPNG
    End If
    
    If ButtonRun.Caption <> "ReGenerate" Or CheckBoxReset.Value Then
        PointSize = val(textboxSize.Text)
        tScaleWidth = PointSize / 10 * MagicScalingFactor  ' 1/10 is for the default LaTeX point size (10 pt)
        tScaleHeight = tScaleWidth
    Else
        ' Handle the case of Texpoint displays
        isTexpoint = False
        Dim OldDpi As Long
        OldDpi = OutputDpi
        With oldshape.Tags
            If .Item("TEXPOINTSCALING") <> "" Then
                isTexpoint = True
                tScaleWidth = val(.Item("TEXPOINTSCALING")) * MagicScalingFactor
                tScaleHeight = tScaleWidth
            End If
            If .Item("OUTPUTDPI") <> "" Then
                OldDpi = val(.Item("OUTPUTDPI"))
            End If
        End With
        If Not isTexpoint Then ' modifying a normal display, either PNG or EMF
            HeightOld = oldshape.Height
            WidthOld = oldshape.Width
            tScaleHeight = 1
            tScaleWidth = 1
            If oldshapeIsEMF = False Then ' this deals with displays from very old versions of IguanaTex that lack proper size tags
                oldshape.ScaleHeight 1#, msoTrue
                oldshape.ScaleWidth 1#, msoTrue
                tScaleHeight = HeightOld / oldshape.Height * 960 / OutputDpi ' 0.8=960/1200 is there to preserve scaling of displays created with old versions of IguanaTex
                tScaleWidth = WidthOld / oldshape.Width * 960 / OutputDpi
            End If
            With oldshape.Tags
                If .Item("ORIGINALHEIGHT") <> "" Then
                    tmpHeight = val(.Item("ORIGINALHEIGHT"))
                    tScaleHeight = HeightOld / tmpHeight * OldDpi / OutputDpi
                End If
                If .Item("ORIGINALWIDTH") <> "" Then
                    tmpWidth = val(.Item("ORIGINALWIDTH"))
                    tScaleWidth = WidthOld / tmpWidth * OldDpi / OutputDpi
                End If
            End With
            If UseEMF = True And oldshapeIsEMF = False Then
                tScaleHeight = tScaleHeight * MagicScalingFactorEMF / MagicScalingFactorPNG
                tScaleWidth = tScaleWidth * MagicScalingFactorEMF / MagicScalingFactorPNG
            ElseIf UseEMF = False And oldshapeIsEMF = True Then
                tScaleHeight = tScaleHeight / MagicScalingFactorEMF * MagicScalingFactorPNG
                tScaleWidth = tScaleWidth / MagicScalingFactorEMF * MagicScalingFactorPNG
            End If
        End If
    End If
    
    
    ' Insert image and rescale it
    Dim newShape As Shape
    Set newShape = AddDisplayShape(TempPath + FinalFilename, PosX, PosY)
    
    If UseEMF Then
        ' Rescale the EMF picture before converting into PPT object
        Set newShape = ConvertEMF(newShape, VectorScalingX * tScaleWidth, VectorScalingY * tScaleHeight)
        ' Tag shape and its components with their "original" sizes,
        ' which we get by dividing their current height/width by the scaling factors applied above
        newShape.Tags.Add "ORIGINALHEIGHT", newShape.Height / tScaleHeight
        newShape.Tags.Add "ORIGINALWIDTH", newShape.Width / tScaleWidth
        If newShape.Type = msoGroup Then
            For Each s In newShape.GroupItems
                s.Tags.Add "ORIGINALHEIGHT", s.Height / tScaleHeight
                s.Tags.Add "ORIGINALWIDTH", s.Width / tScaleWidth
            Next
        End If

    Else
        ' Resize to the true size of the png file and adjust using the manual scaling factors set in Main Settings
        With newShape
            .ScaleHeight 1#, msoTrue
            .ScaleWidth 1#, msoTrue
            .LockAspectRatio = msoFalse
            .ScaleHeight BitmapScalingY, msoFalse
            .ScaleWidth BitmapScalingX, msoFalse
            .Tags.Add "OUTPUTDPI", OutputDpi ' Stores this display's resolution
            ' Add tags storing the original height and width, used next time to keep resizing ratio.
            .Tags.Add "ORIGINALHEIGHT", newShape.Height
            .Tags.Add "ORIGINALWIDTH", newShape.Width
            ' Apply scaling factors
            .ScaleHeight tScaleHeight, msoFalse
            .ScaleWidth tScaleWidth, msoFalse
            .LockAspectRatio = msoTrue
        End With
    End If
        
    If ButtonRun.Caption = "ReGenerate" Then ' We are editing+resetting size of an old display, we keep rotation
        newShape.Rotation = oldshape.Rotation
        If Not CheckBoxReset.Value Then
            newShape.LockAspectRatio = oldshape.LockAspectRatio ' Unlock aspect ratio if old display had it unlocked
        End If
    End If
    
    ' Add tags
    Call AddTagsToShape(newShape)
    If UseEMF = True And newShape.Type = msoGroup Then
        Set s = newShape.GroupItems(1)
        Call AddTagsToShape(s) 'only left most for now, to make things simple
        For Each s In newShape.GroupItems
        '    Call AddTagsToShape(s)
            s.Tags.Add "EMFchild", True
        Next
    End If
    
    ' Copy animation settings and formatting from old image, then delete it
    If ButtonRun.Caption = "ReGenerate" Then
        Dim TransferDesign As Boolean
        TransferDesign = True
        If UseEMF <> oldshapeIsEMF Or CheckBoxResetFormat.Value Then
            TransferDesign = False
        End If
        If IsInGroup Then
            ' Transfer format to new shape
            MatchZOrder oldshape, newShape
            If TransferDesign Then
                oldshape.PickUp
                newShape.Apply
            End If
            ' Handle the case of shape within EMF group.
            Dim DeleteLowestLayer As Boolean
            DeleteLowestLayer = False
            If oldshape.Tags.Item("EMFchild") <> "" Then
                DeleteLowestLayer = True
            End If
            oldshape.Delete
            
            Dim newGroup As Shape
            ' Get current slide, it will be used to group ranges
            Dim sld As Slide
            Dim SlideIndex As Long
            SlideIndex = ActiveWindow.View.Slide.SlideIndex
            Set sld = ActivePresentation.Slides(SlideIndex)

            ' Group all non-modified elements from old group, plus modified element
            j = j + 1
            ReDim Preserve arr(1 To j)
            arr(j) = newShape.name
            If DeleteLowestLayer Then
                Dim arr_remain() As Variant
                j_remain = 0
                For Each n In arr
                    Set s = ActiveWindow.Selection.SlideRange.Shapes(n)
                    ThisShapeLevel = 0
                    For i_tag = 1 To s.Tags.count
                        If (s.Tags.name(i_tag) = "LAYER") Then
                            ThisShapeLevel = val(s.Tags.Value(i_tag))
                        End If
                    Next
                    If ThisShapeLevel = 1 Then
                        s.Delete
                    Else
                        j_remain = j_remain + 1
                        ReDim Preserve arr_remain(1 To j_remain)
                        arr_remain(j_remain) = s.name
                    End If
                Next
                newShape.Tags.Add "LAYER", 2
                arr = arr_remain
            Else
                newShape.Tags.Add "LAYER", 1
            End If
            newShape.Tags.Add "SELECTIONNAME", newShape.name
            
            ' Hierarchically re-group elements
            For Level = 1 To MaxGroupLevel
                Dim CurrentLevelArr() As Variant
                j_current = 0
                For Each n In arr
                    ThisShapeLevel = 0
                    Dim ThisShapeSelectionName As String
                    ThisShapeSelectionName = ""
                    On Error Resume Next
                    With ActiveWindow.Selection.SlideRange.Shapes(n).Tags
                        For i_tag = 1 To .count
                            If (.name(i_tag) = "LAYER") Then
                                ThisShapeLevel = val(.Value(i_tag))
                            End If
                            If (.name(i_tag) = "SELECTIONNAME") Then
                                ThisShapeSelectionName = .Value(i_tag)
                            End If
                        Next
                    End With
                    
                    
                    If ThisShapeLevel = Level Then
                        If j_current > 0 Then
                            If Not IsInArray(CurrentLevelArr, ThisShapeSelectionName) Then
                                j_current = j_current + 1
                                ReDim Preserve CurrentLevelArr(1 To j_current)
                                CurrentLevelArr(j_current) = ThisShapeSelectionName
                            End If
                        Else
                            j_current = j_current + 1
                            ReDim Preserve CurrentLevelArr(1 To j_current)
                            CurrentLevelArr(j_current) = ThisShapeSelectionName
                        End If
                    End If
                Next
                
                If j_current > 1 Then
                    Set newGroup = sld.Shapes.Range(CurrentLevelArr).Group
                    j = j + 1
                    ReDim Preserve arr(1 To j)
                    arr(j) = newGroup.name
                    newGroup.Tags.Add "SELECTIONNAME", newGroup.name
                    newGroup.Tags.Add "LAYER", Level + 1
                End If
                
            Next
            
            ' Delete the tags to avoid conflict with future runs
            For Each n In arr
                On Error Resume Next
                    ActiveWindow.Selection.SlideRange.Shapes(n).Tags.Delete ("SELECTIONNAME")
                    ActiveWindow.Selection.SlideRange.Shapes(n).Tags.Delete ("LAYER")
            Next
            
            ' Use temporary group to retrieve the group's original animation and Zorder
            MoveAnimation tmpGroup, newGroup
            MatchZOrder tmpGroup, newGroup
            tmpGroup.Delete
        Else
            MoveAnimation oldshape, newShape
            MatchZOrder oldshape, newShape
            If TransferDesign Then
                If oldshapeIsEMF And oldshape.Type = msoGroup Then
                    
                    ' First transfer group format to temporary shape
                    ' (we use a duplicate of the old EMF shape)
                    Dim tmpGroupEMF As Shape
                    Set tmpGroupEMF = oldshape.Duplicate(1)
                    'TransferGroupFormat oldshape, tmpGroupEMF
                    
                    ' Transfer shape formatting
                    ' First need to delete all but one shape in the group to unlock the format pickup
                    Dim tmpshp As Shape
                    Set tmpshp = oldshape.GroupItems(1)
                    For j = oldshape.GroupItems.count To 2 Step -1
                        ' Delete backwards because Powerpoint renumbers
                        ' We could also always delete .GroupItems(2) ...
                        oldshape.GroupItems(j).Delete
                    Next
                    tmpshp.PickUp
                    
                    ' Transfer shape formatting to each shape within the group
                    For Each s In newShape.GroupItems
                        s.Apply
                    Next
                    tmpshp.Delete
                    
                    ' Now we can transfer the group formatting from the temporary shape
                    TransferGroupFormat tmpGroupEMF, newShape
                    tmpGroupEMF.Delete
                Else
                    oldshape.PickUp
                    newShape.Apply
                    oldshape.Delete
                End If
            Else
                oldshape.Delete
            End If
        End If
    End If
    
    
    ' Select the new shape
    newShape.Select
    
    
    ' Delete temp files if not in debug mode
    If debugMode = False Then fs.DeleteFile TempPath + FilePrefix + "*.*"
    
    
    
    FrameProcess.Visible = False
    Unload LatexForm
Exit Sub
   
End Sub

Private Sub AddTagsToShape(vSh As Shape)
    With vSh.Tags
        .Add "LATEXADDIN", TextBox1.Text
        .Add "IguanaTexSize", val(textboxSize.Text)
        .Add "IGUANATEXCURSOR", TextBox1.SelStart
        .Add "TRANSPARENCY", checkboxTransp.Value
        .Add "FILENAME", TextBoxFile.Text
        .Add "LATEXENGINEID", ComboBoxLaTexEngine.ListIndex
        .Add "TEMPFOLDER", TextBoxTempFolder.Text
        .Add "LATEXFORMHEIGHT", LatexForm.Height
        .Add "LATEXFORMWIDTH", LatexForm.Width
        .Add "LATEXFORMWRAP", TextBox1.WordWrap
        .Add "BitmapVector", ComboBoxBitmapVector.ListIndex
    End With
End Sub



Private Function ConvertEMF(inSh As Shape, ScalingX As Single, ScalingY As Single, _
                            Optional FileType As String = "emf", Optional ConvertLines As Boolean = True) As Shape
    With inSh
        .ScaleHeight 1#, msoTrue
        .ScaleWidth 1#, msoTrue
        .LockAspectRatio = msoFalse
        .ScaleHeight ScalingY, msoTrue
        .ScaleWidth ScalingX, msoTrue
        .LockAspectRatio = msoTrue
    End With
    
    Dim newShape As Shape
    ' Get current slide, it will be used to group ranges
    Dim sld As Slide
    Dim SlideIndex As Long
    SlideIndex = ActiveWindow.View.Slide.SlideIndex
    Set sld = ActivePresentation.Slides(SlideIndex)

    ' Convert EMF image to object
    Dim Shr As ShapeRange
    Set Shr = inSh.Ungroup
    If FileType = "emf" Then
        Set Shr = Shr.Ungroup
        ' Clean up
        Shr.Item(1).Delete
        Shr.Item(2).Delete
        If Shr(3).GroupItems.count > 2 Then
            Set newShape = Shr(3)
        Else ' only a single freeform, so not a group
            Set newShape = Shr(3).GroupItems(2)
        End If
        Shr(3).GroupItems(1).Delete
    ElseIf FileType = "eps" Then
        Shr.GroupItems(1).Delete
        Shr.GroupItems(1).Delete
        Set newShape = Shr.Ungroup.Group
    End If
    
    
    If newShape.Type = msoGroup Then
    
        Dim arr_group() As Variant
        arr_group = GetAllShapesInGroup(newShape)
        Call FullyUngroupShape(newShape)
        Set newShape = sld.Shapes.Range(arr_group).Group
        
        Dim emf_arr() As Variant ' gather all shapes to be regrouped later on
        j_emf = 0
        Dim delete_arr() As Variant ' gather all shapes to be deleted later on
        j_delete = 0
        Dim s As Shape
        For Each s In newShape.GroupItems
            j_emf = j_emf + 1
            ReDim Preserve emf_arr(1 To j_emf)
            If s.Type = msoLine Then
                If ConvertLines And (s.Height > 0 Or s.Width > 0) Then
                    emf_arr(j_emf) = LineToFreeform(s).name
                    j_delete = j_delete + 1
                    ReDim Preserve delete_arr(1 To j_delete)
                    delete_arr(j_delete) = s.name
                Else
                    emf_arr(j_emf) = s.name
                End If
            Else
                emf_arr(j_emf) = s.name
                If s.Fill.Visible = msoTrue Then
                s.Line.Visible = msoFalse
                Else
                s.Line.Visible = msoTrue
                
                End If
            End If
        Next
        newShape.Ungroup
        If j_delete > 0 Then
            sld.Shapes.Range(delete_arr).Delete
        End If
        Set newShape = sld.Shapes.Range(emf_arr).Group
    
    Else
        If newShape.Type = msoLine Then
            newShapeName = LineToFreeform(newShape).name
            newShape.Delete
            Set newShape = sld.Shapes(newShapeName)
        Else
            newShape.Line.Visible = msoFalse
        End If
    End If
    newShape.LockAspectRatio = msoTrue
    Set ConvertEMF = newShape
End Function

Private Sub FullyUngroupShape(newShape As Shape)
    Dim Shr As ShapeRange
    Dim s As Shape
    If newShape.Type = msoGroup Then
        Set Shr = newShape.Ungroup
        For i = 1 To Shr.count
            Set s = Shr.Item(i)
            If s.Type = msoGroup Then
                Call FullyUngroupShape(s)
            End If
        Next
    End If
End Sub

Private Function GetAllShapesInGroup(newShape As Shape) As Variant
    Dim arr() As Variant
    Dim j As Long
    Dim s As Shape
    For Each s In newShape.GroupItems
            j = j + 1
            ReDim Preserve arr(1 To j)
            arr(j) = s.name
    Next
    GetAllShapesInGroup = arr
End Function

Private Function LineToFreeform(s As Shape) As Shape
    t = s.Line.Weight
    Dim ApplyTransform As Boolean
    ApplyTransform = True
    
    Dim bHflip As Boolean
    Dim bVflip As Boolean
    Dim nBegin As Long
    Dim nEnd As Long
    Dim aC(1 To 4, 1 To 2) As Double
    
    With s
        aC(1, 1) = .Left:           aC(1, 2) = .Top
        aC(2, 1) = .Left + .Width:  aC(2, 2) = .Top
        aC(3, 1) = .Left:           aC(3, 2) = .Top + .Height
        aC(4, 1) = .Left + .Width:  aC(4, 2) = .Top + .Height
    
        bHflip = .HorizontalFlip
        bVflip = .VerticalFlip
    End With
    
    If bHflip = bVflip Then
        If bVflip = False Then
            ' down to right -- South-East
            nBegin = 1: nEnd = 4
        Else
            ' up to left -- North-West
            nBegin = 4: nEnd = 1
        End If
    ElseIf bHflip = False Then
        ' up to right -- North-East
        nBegin = 3: nEnd = 2
    Else
        ' down to left -- South-West
        nBegin = 2: nEnd = 3
    End If
    xs = aC(nBegin, 1)
    ys = aC(nBegin, 2)
    xe = aC(nEnd, 1)
    ye = aC(nEnd, 2)
    
    ' Get unit vector in orthogonal direction
    xd = xe - xs
    yd = ye - ys
    
    s_length = Sqr(xd * xd + yd * yd)
    If s_length > 0 Then
    n_x = -yd / s_length
    n_y = xd / s_length
    Else
    n_x = 0
    n_y = 0
    End If
    
    x1 = xs + n_x * t / 2
    y1 = ys + n_y * t / 2
    x2 = xe + n_x * t / 2
    y2 = ye + n_y * t / 2
    x3 = xe - n_x * t / 2
    y3 = ye - n_y * t / 2
    x4 = xs - n_x * t / 2
    y4 = ys - n_y * t / 2
        
    'End If
    
    
    If ApplyTransform Then
        Dim builder As FreeformBuilder
        Set builder = ActiveWindow.Selection.SlideRange(1).Shapes.BuildFreeform(msoEditingCorner, x1, y1)
        builder.AddNodes msoSegmentLine, msoEditingAuto, x2, y2
        builder.AddNodes msoSegmentLine, msoEditingAuto, x3, y3
        builder.AddNodes msoSegmentLine, msoEditingAuto, x4, y4
        builder.AddNodes msoSegmentLine, msoEditingAuto, x1, y1
        Dim oSh As Shape
        Set oSh = builder.ConvertToShape
        oSh.Fill.ForeColor = s.Line.ForeColor
        oSh.Fill.Visible = msoTrue
        oSh.Line.Visible = msoFalse
        oSh.Rotation = s.Rotation
        Set LineToFreeform = oSh
    Else
        Set LineToFreeform = s
    End If
End Function

Private Function IsInArray(arr As Variant, valueToCheck As String) As Boolean
    IsInArray = False
    For Each n In arr
        If n = valueToCheck Then
            IsInArray = True
            Exit For
        End If
    Next

End Function

Private Function TagGroupHierarchy(arr As Variant, TargetName As String) As Long
    ' Arr is the list of names of (leaf) elements in this group
    ' TargetName is the display which is being modified. We're going down the branch containing it.
    Dim Sel As Selection
    ActiveWindow.Selection.SlideRange.Shapes(TargetName).Select
    Set Sel = Application.ActiveWindow.Selection
    
…