Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 b5f1d569f0ed5653…

MALICIOUS

Office (OLE)

123.5 KB Created: 2007-04-02 11:56:57 Authoring application: Microsoft Excel First seen: 2019-04-17
MD5: 5aa8c42dbe62af0bf475f7eff7976f4a SHA-1: e4a24aef0001307ee80434941b873a867cafdd21 SHA-256: b5f1d569f0ed5653ed373b024f30c5d1da3ae5d47d2e26c588460533209c472a
268 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1059 Command and Scripting Interpreter

The file contains VBA macros, including a Workbook_Open event, which is a common technique for executing malicious code upon opening the document. Critical heuristics indicate the use of Shell() and WScript.Shell, suggesting the macro attempts to execute external commands or scripts. The presence of these elements strongly indicates an intent to download and execute a secondary payload.

Heuristics 7

  • VBA macros detected medium 5 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
    Sub Read_registry_Value()
    Dim Shell As Object
    Dim keyname As String
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        value = "TempDir"
     Set Shell = CreateObject("wscript.shell")
    On Error Resume Next
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        value = "TempDir"
     Set Shell = CreateObject("wscript.shell")
    On Error Resume Next
  • 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
    Private Sub Workbook_Open()
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 104646 bytes
SHA-256: 0824981f862df7c80d89a04787721728eceebf7d0708f9c912e75f280981f23f
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisWorkbook"
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()
    
    AddMenu
    DoEvents
    DoEvents
    white
    'UPDBook
    
    
    
    
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 If exlstring = True Then
   SendString "[" + ActiveWorkbook.Name + "]" + ActiveSheet.Name + "*Module "
 'Else
  ' SendString "[" + ActiveWorkbook.Name + "]" + ActiveSheet.Name + "*Module "
End If

 
End Sub

Attribute VB_Name = "CapitaMacros"
Global g_ReciverHwnd As Long
#If Win64 Then
 Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
 Public Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
 Public Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 Public Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 Public Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As Long
#Else
 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
 Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
 Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
#End If


#If Win64 Then
    Private Type copyDataStruct
        dwData As LongLong
        cbData As LongLong
        lpData As LongLong
    End Type
#Else
    Private Type copyDataStruct
        dwData As Long
        cbData As Long
        lpData As Long
    End Type
#End If


Private Const WM_COPYDATA = &H4A
Global exlstring As Boolean
Global imgno As Integer
Dim TargetHwnd As Double
Dim spath As String
Dim sText As String

Sub MnuAbout()
    SendString "MnuAbout"
End Sub
Sub UPDMODULE()
    exlstring = True
    DoEvents
    SendString "[" + ActiveWorkbook.Name + "]" + ActiveSheet.Name + "?Module "
    
End Sub
Sub UPDSheet()
    exlstring = False
    DoEvents
    SendString "~[" + ActiveWorkbook.Name + "]" + ActiveSheet.Name
End Sub
Sub UPDBook()
    exlstring = False
    DoEvents
    Dim ASheetList As String
    ASheetList = GetSheetList
    'SendString "[" + ActiveWorkbook.Name + "]"
    SendString "~" + ASheetList
    DoEvents
End Sub
Sub UPDAll()
    exlstring = False
    DoEvents
    SendString "ALL"
End Sub
Sub SendString(str As String)
Dim cDStruct As copyDataStruct
Dim x(1 To 255) As Byte
  cDStruct.dwData = 0
  cDStruct.cbData = Len(str) + 1
  str = Trim$(str)
  Call CopyMemory(x(1), ByVal str, Len(str))
  cDStruct.lpData = CLng(VarPtr(x(1)))
  DoEvents
  Call SendData(cDStruct)
  DoEvents
End Sub
Sub SendData(CapitaStruct As copyDataStruct)
Dim res As Integer
Dim Handle As Long

 TargetHwnd = 0
 
'EnumWindows AddressOf WindowEnumerator, 0 'Nadesh on 19-07-2010
'If receiverHandle <> g_ReciverHwnd Then
    'receiverHandle = g_ReciverHwnd
'End If
  
 TargetHwnd = FindWindow("TMainForm", vbNullString)

 If TargetHwnd = 0 Then
      MsgBox "CapitaLine Application NOT found!", vbInformation, "Capitaline"
   Exit Sub
 End If
 DoEvents
 res = SendMessage(TargetHwnd, WM_COPYDATA, FindWindow("XLMAIN", Application.Caption), CapitaStruct)
 DoEvents
 DoEvents
End Sub
Sub GetReceiverHWND(hwnd As Long)
    g_ReciverHwnd = hwnd
End Sub
Sub AddMenu()
 Dim CMMenu As Menu, ctlCBarControl As CommandBarControl
    
    On Error Resume Next
    Set ctlCBarControl = CommandBars("Worksheet Menu Bar").Controls("Update")
    
    If Err <> 0 Then
        Set CMMenu = MenuBars(xlWorksheet).Menus.Add("Update", "&Window")
           CMMenu.MenuItems.Add "&Sheet", "UPDSheet"
           CMMenu.MenuItems.Add "&Workbook", "UPDBook"
           CMMenu.MenuItems.Add "-"
           CMMenu.MenuItems.Add "&All open files", "UPDAll"
           CMMenu.MenuItems.Add "-"
           CMMenu.MenuItems.Add "&Select Company", "UPDMODULE"
           CMMenu.MenuItems.Add "-"
           CMMenu.MenuItems.Add "A&bout Capitaline", "MnuAbout"
     End If
End Sub
Public Function WindowEnumerator(ByVal app_hwnd As Long, _
    ByVal lParam As Long) As Long
Dim buf As String * 256
Dim title As String
Dim ClassName As String
Dim length As Long
Dim sClassName As String * 100

    length = GetWindowText(app_hwnd, buf, Len(buf))
    title = left$(buf, length)
    length = GetClassName(app_hwnd, sClassName, 100)
    ClassName = left$(sClassName, length)
    
    If InStr(UCase(title), "CAPITALINE") = 1 And ClassName = "TMainForm" Then
        TargetHwnd = app_hwnd
        WindowEnumerator = False
    Else
        WindowEnumerator = True
    End If
End Function
Sub clearsheet()
   With Selection
       .MergeCells = False
       .ClearContents
   End With
   For Each Shapes In ActiveSheet.Shapes
     Shapes.Delete
   Next
 Range("A1:A1").Select
 End Sub
 
  
Sub merge()
   Selection.merge
  
End Sub
Sub insert()
 spath = ""
 Read_registry_Value
 Encrypt (sText)
 ActiveSheet.Pictures.insert(spath + "LineGraph" + CStr(imgno) + ".bmp").Select
 'ActiveSheet.Pictures (spath + "LineGraph" + CStr(imgno) + ".bmp")
 imgno = imgno + 1
 If imgno > 1 Then imgno = 0
 
 
End Sub

Sub Encrypt(sText As String)
Dim sResult, mChar As String
sLen = Len(sText)
For i = 1 To sLen
 mChar = Chr(Asc(Mid(sText, i, 1)) - sLen - i)
 spath = spath & mChar
Next i

End Sub
Sub Read_registry_Value()
    Dim Shell As Object
    Dim keyname As String
    Dim value As String
    Dim keyvalue As String
    keyname = "HKEY_LOCAL_MACHINE\SOFTWARE\CLPLUS\"
    value = "TempDir"
     Set Shell = CreateObject("wscript.shell")
    On Error Resume Next
    keyvalue = Shell.regread(keyname & value)
    On Error GoTo 0
    sText = keyvalue
End Sub

Sub bold()
 Selection.Font.bold = True
End Sub

Sub right()
 With Selection
  .HorizontalAlignment = xlRight
  .VerticalAlignment = xlBottom
 End With
End Sub
Sub left()
 With Selection
       .HorizontalAlignment = xlLeft
       .VerticalAlignment = xlBottom
     
 End With
End Sub
Sub centre()
 With Selection
       .HorizontalAlignment = xlHAlignCenter
       .VerticalAlignment = xlBottom
     
 End With
End Sub
Sub chart2()
   Selection.ShapeRange.ScaleHeight 1, 0, 0
   Selection.ShapeRange.ScaleWidth 1.5, 0, 0
End Sub
Sub chart1()
  Selection.ShapeRange.ScaleHeight 0.95, 0, 0
  Selection.ShapeRange.ScaleWidth 1.1, 0, 0
End Sub
Sub size()
  Selection.ColumnWidth = 10
End Sub
Sub white()
 Range("A2").Select
 Selection.Font.ColorIndex = 2
End Sub
Sub selectcell()
   Range("A1").Select
End Sub
Sub exltrue()
 exlstring = True
End Sub

Sub exlfalse()
 exlstring = False
End Sub

Sub InspireCapital()
' Macro to Convert the Company analysis template to Inspire Capital Template on 23/02/2010
    Dim ASheet As String, BSheet As String
    Dim AFormula As String
    ASheet = ActiveSheet.Name
    Sheets(ASheet).Select
    Sheets.Add
    ActiveSheet.Name = "REPORT"
    BSheet = ActiveSheet.Name
    Sheets(ASheet).Select
    Rows("3:8").Select
    Selection.Copy
    Sheets(BSheet).Select
    Range("A3").Select
    ActiveSheet.Paste
    Range("E5:F8").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A16").Select
    Sheets(ASheet).Select
    Rows("10:12").Select
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Sheets(ASheet).Select
    Rows("49:49").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    Range("A19").Select
    ActiveSheet.Paste
    Sheets(ASheet).Select
    Rows("201:203").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    Range("A20").Select
    ActiveSheet.Paste
    Sheets(ASheet).Select
    Rows("52:52").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    Range("A23").Select
    ActiveSheet.Paste
    Sheets(ASheet).Select
    Rows("53:69").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    Range("A24").Select
    ActiveSheet.Paste
    Rows("29:29").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A40").Select
    Sheets(ASheet).Select
    Rows("51:51").Select
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Sheets(ASheet).Select
    Rows("70:77").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    Range("A41").Select
    ActiveSheet.Paste
    Range("A49").Select
    Sheets(ASheet).Select
    Rows("33:37").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Range("A55").Select
    Sheets(ASheet).Select
    Rows("78:92").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Range("A70").Select
    Sheets(ASheet).Select
    Rows("131:145").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Range("A87").Select
    Sheets(ASheet).Select
    Rows("93:100").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Range("A95").Select
    Sheets(ASheet).Select
    Rows("41:48").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Range("A104").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Margins Ratios (%)"
    Range("A105").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Excise/Sales"
    Range("A106").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Raw Material/ Sales"
    Range("A107").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Wages & Salaries/ Sales"
    Range("A108").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Energy (Power & Fuel)/ Sales"
    Range("A109").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Admin. Exp./ Sales"
    Range("A110").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Selling & Dist. Exp./ Sales"
    Range("A111").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Other Exps/ Sales"
    Range("A112").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'PBITDA/ Sales"
    Range("A113").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Other Income/ PBT"
    Range("A114").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Tax/ Pretax"
    Range("A115").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Depreciation/ Net Block"
'    Range("B104").Select
'    ActiveCell.FormulaR1C1 = "=R[-83]C/R[-84]C"
'    Range("B104").Select
'    Selection.Style = "Percent"
'    Selection.NumberFormat = "0.0%"
    Range("B105").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-84]C/R[-85]C"
    Range("B105").Select
    Selection.Style = "Percent"
    Selection.NumberFormat = "0.0%"
    Selection.NumberFormat = "0.00%"
    Range("B106").Select
    ActiveCell.FormulaR1C1 = "=R[-80]C/R[-86]C"
    Range("B105").Select
    Selection.Copy
    Range("B106").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-80]C/R20C"
    Range("B106").Select
    Selection.AutoFill Destination:=Range("B106:B111"), Type:=xlFillDefault
    Range("B106:B111").Select
    Range("B105:B111").Select
    Selection.AutoFill Destination:=Range("B105:K111"), Type:=xlFillDefault
    Range("B105:K111").Select
    Range("B112").Select
    Selection.Style = "Percent"
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.NumberFormat = "0.00%"
    ActiveCell.FormulaR1C1 = "=R[-76]C/R[-90]C"
    Range("B113").Select
    Selection.Style = "Percent"
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.NumberFormat = "0.00%"
    ActiveCell.FormulaR1C1 = "=R[-73]C/R[-72]C"
    Range("B114").Select
    ActiveCell.FormulaR1C1 = "=R[-72]C/R[-73]C"
    Range("B115").Select
    ActiveCell.FormulaR1C1 = "=R[-76]C/R[-51]C"
    Range("B113").Select
    Selection.Copy
    Range("B114:B115").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    Range("B112:B115").Select
    Selection.AutoFill Destination:=Range("B112:K115"), Type:=xlFillDefault
    Range("B112:K115").Select
    Range("B115").Select
    ActiveWindow.SmallScroll Down:=-60
    Range("B36").Select
    AFormula = "='" & ASheet & "'!R[30]C-'" & BSheet & "'!R[4]C"
    ActiveCell.FormulaR1C1 = AFormula
    'ActiveCell.FormulaR1C1 = "=Sheet1!R[30]C-Sheet2!R[4]C"
    Range("B36").Select
    Selection.AutoFill Destination:=Range("B36:K36"), Type:=xlFillDefault
    Range("B36:K36").Select
    Range("B38").Select
    AFormula = "='" & ASheet & "'!R[30]C-'" & BSheet & "'!R[2]C"
    'ActiveCell.FormulaR1C1 = "=Sheet1!R[30]C-Sheet2!R[2]C"
    ActiveCell.FormulaR1C1 = AFormula
    Range("B38").Select
    Selection.AutoFill Destination:=Range("B38:K38"), Type:=xlFillDefault
    Range("B38:K38").Select
    ActiveWindow.SmallScroll Down:=63
    Range("A118").Select
    Sheets(ASheet).Select
    ActiveWindow.SmallScroll Down:=51
    Rows("109:110").Select
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Sheets(ASheet).Select
    Rows("112:112").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    Range("A120").Select
    ActiveSheet.Paste
    Range("A119").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "'ROE"
    Range("A120").Select
    ActiveCell.FormulaR1C1 = "'ROCE"
    Range("A104").Select
    Selection.Font.bold = True
    Range("A121").Select
    Sheets(ASheet).Select
    Rows("114:123").Select
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Range("A131").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'Valuations: High/ Low"
    Range("A131").Select
    Selection.Font.bold = True
    Range("A134").Select
    Sheets(ASheet).Select
    Rows("14:31").Select
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    Range("A154").Select
    Sheets(ASheet).Select
    Rows("155:198").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(BSheet).Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=42
    Range("A198").Select
    Application.CutCopyMode = False
    Columns("B:L").Select
    Selection.ColumnWidth = 13.14
    Columns("A:A").Select
    Selection.ColumnWidth = 27
    ActiveSheet.Cells(3, 9).value = "Share Price Graph"
    ActiveSheet.Cells(3, 9).Font.bold = True
    ActiveSheet.Cells(4, 9).Select
    ActiveSheet.Cells(116, 1).value = "Total Exp./Sales"
    ActiveSheet.Cells(116, 2).value = "=B33/B22"
    ActiveSheet.Cells(116, 2).NumberFormat = "0.00%"
    ActiveSheet.Cells(116, 2).Select
    Selection.AutoFill Destination:=Range("B116:K116"), Type:=xlFillDefault
    
    'Quarterly Section 28-May-2010
    Sheets(ASheet).Select
    Sheet1.Rows("218:228").Select
    Selection.Copy
    Sheets(BSheet).Select
    Rows("164:164").Select
    Selection.insert Shift:=xlDown
    Rows("175:175").Select
    Application.CutCopyMode = False
    Selection.insert Shift:=xlDown
    MarginRatios BSheet
    
    On Error Resume Next
    spath = ""
    Read_registry_Value
    Encrypt (sText)
    ActiveSheet.Pictures.insert(spath + "LineGraph.bmp").Select
    Selection.left = ActiveSheet.Range("I4").left
    Selection.Top = ActiveSheet.Range("I4").Top

    With ActiveSheet.Pictures.insert(spath + "LineGraph.bmp")
     .left = ActiveSheet.Range("I4").left
     .Top = ActiveSheet.Range("I4").Top
    End With
    Columns("A:L").EntireColumn.AutoFit
    ActiveSheet.Cells(2, 1).Select
End Sub

Sub ClearCells()
  Selection.ClearContents
End Sub
'For Inspire Capital Margin Ratios on 28-May-2010
Sub MarginRatios(ASheetName As String)
    Sheets(ASheetName).Select
    Range("A211").value = "Margins Ratios (%)"
    Range("A211").Font.bold = True
    Range("A212").value = "Excise/Sales"
    Range("A213").value = "Raw Material/ Sales"
    Range("A214").value = "Wages & Salaries/ Sales"
    Range("A215").value = "Energy (Power & Fuel)/ Sales"
    Range("A216").value = "Selling & Admin. Exp./ Sales"
    Range("A217").value = "Other Exps/ Sales"
    Range("A218").value = "Other Income/ PBT"
    Range("A219").value = "Tax/ Pretax"
    Range("A220").value = "Total Exp./Sales"
    
    Range("B212").Select
    ActiveCell.FormulaR1C1 = "=R[-54]C/R[-53]C"
    Range("B213").Select
    ActiveCell.FormulaR1C1 = "=R[-49]C/R[-54]C"
    Range("B214").Select
    ActiveCell.FormulaR1C1 = "=R[-47]C/R[-55]C"
    Range("B215").Select
    ActiveCell.FormulaR1C1 = "=R[-47]C/R[-56]C"
    Range("B216").Select
    ActiveCell.FormulaR1C1 = "=R[-47]C/R[-57]C"
    Range("B217").Select
    ActiveCell.FormulaR1C1 = "=R[-44]C/R[-58]C"
    Range("B218").Select
    ActiveCell.FormulaR1C1 = "=R[-58]C/(R[-40]C-R[-39]C)"
    Range("B219").Select
    ActiveCell.FormulaR1C1 = "=(R[-39]C+R[-38]C+R[-37]C)/(R[-41]C-R[-40]C)"
    Range("B220").Select
    ActiveCell.FormulaR1C1 = "=R[-46]C/R[-61]C"
    Range("B212:B220").Select
    Selection.NumberFormat = "0.00%"
    Selection.AutoFill Destination:=Range("B212:K220"), Type:=xlFillDefault
End Sub
'Nadesh on 22-Jul-2010
Public Function GetSheetList() As String
   Dim ShList As String, WBName As String
   Dim S As Integer, ACount As Integer
   ACount = ActiveWorkbook.Sheets.Count
   WBName = "[" + ActiveWorkbook.Name + "]"
   For S = 1 To ACount - 1
     ShList = ShList + WBName + ActiveWorkbook.Sheets(S).Name + "|"
   Next
   ShList = ShList + WBName + ActiveWorkbook.Sheets(ACount).Name
   GetSheetList = ShList
End Function
Public Sub ClearData()
  Dim ClCount As Integer
  Dim RwCount As Integer
  ClCount = ActiveSheet.UsedRange.Columns.Count
  RwCount = ActiveSheet.UsedRange.Rows.Count
   ActiveSheet.Range(ActiveSheet.Cells(4, 1), ActiveSheet.Cells(RwCount, ClCount)).ClearContents
End Sub
Public Sub ChkBoxCreation()
Dim oxlObj As OLEObject
  Set oxlObj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, left:=Range("C3").left, _
               Top:=Range("C3").Top, Width:=108, Height:=21)
  With oxlObj.Object
     .Caption = "i-Lens Adjustments"
     .Font.size = 9
     .value = True
  End With
  oxlObj.Name = "LensAdj"
End Sub
Sub ChkEventProcedure()
Dim LineNum As Long
Set VBAEditor = Application.VBE
Set vbProj = VBAEditor.ActiveVBProject
Set VBComp = ActiveWorkbook.VBProject.VBComponents("CapitaMacros")
Set CodeMod = ActiveWorkbook.VBProject.VBComponents("CapitaMacros").CodeModule
Set vbProj = ActiveWorkbook.VBProject
Set VBComp = vbProj.VBComponents("Sheet2")
Set CodeMod = VBComp.CodeModule
With CodeMod
 LineNum = .CountOfLines + 1
 .InsertLines LineNum, "Private Sub LensAdj_Click()"
  LineNum = LineNum + 1
 .InsertLines LineNum, "If Sheet2.LensAdj.value = True Then"
  LineNum = LineNum + 1
 .InsertLines LineNum, "Sheet2.Cells(4, 1).value = True"
  LineNum = LineNum + 1
 .InsertLines LineNum, "Else"
  LineNum = LineNum + 1
 .InsertLines LineNum, "Sheet2.Cells(4, 1).value = False"
  LineNum = LineNum + 1
 .InsertLines LineNum, "End If"
  LineNum = LineNum + 1
 .InsertLines LineNum, "End Sub"
End With
End Sub

Sub CmbChangeEvent()
Dim LineNum As Long
Set VBAEditor = Application.VBE
Set vbProj = VBAEditor.ActiveVBProject
Set VBComp = ActiveWorkbook.VBProject.VBComponents("CapitaMacros")
Set CodeMod = ActiveWorkbook.VBProject.VBComponents("CapitaMacros").CodeModule
Set vbProj = ActiveWorkbook.VBProject
Set VBComp = vbProj.VBComponents("Sheet6")
Set CodeMod = VBComp.CodeModule
With CodeMod
 LineNum = .CountOfLines + 1
 
 LineNum = LineNum + 1
 .InsertLines LineNum, "Private Sub Worksheet_Activate()"
 LineNum = LineNum + 1
 .InsertLines LineNum, "  ComboBox1.ListIndex = 0"
 LineNum = LineNum + 1
 .InsertLines LineNum, "End Sub"
 
 .InsertLines LineNum, "Private Sub ComboBox1_Change()"
  LineNum = LineNum + 1
 .InsertLines LineNum, "  Dim Rn As String"
  LineNum = LineNum + 1
 .InsertLines LineNum, " If ComboBox1.ListIndex = 0 Then "
  LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL( ""D"") "
  LineNum = LineNum + 1
 .InsertLines LineNum, " ElseIf ComboBox1.ListIndex = 1 Then "
 LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL (""E"") "
  LineNum = LineNum + 1
 .InsertLines LineNum, " ElseIf ComboBox1.ListIndex = 2 Then "
 LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL (""F"") "
  LineNum = LineNum + 1
 .InsertLines LineNum, " ElseIf ComboBox1.ListIndex = 3 Then"
 LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL (""G"") "
  LineNum = LineNum + 1
 .InsertLines LineNum, " ElseIf ComboBox1.ListIndex = 4 Then"
 LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL (""H"") "
  LineNum = LineNum + 1
 .InsertLines LineNum, " ElseIf ComboBox1.ListIndex = 5 Then"
 LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL (""I"") "
  LineNum = LineNum + 1
 .InsertLines LineNum, " ElseIf ComboBox1.ListIndex = 6 Then"
 LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL (""J"") "
  LineNum = LineNum + 1
 .InsertLines LineNum, " ElseIf ComboBox1.ListIndex = 7 Then"
 LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL (""K"") "
  LineNum = LineNum + 1
 .InsertLines LineNum, " ElseIf ComboBox1.ListIndex = 8 Then"
 LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL (""L"") "
  LineNum = LineNum + 1
 .InsertLines LineNum, " ElseIf ComboBox1.ListIndex = 9 Then"
 LineNum = LineNum + 1
 .InsertLines LineNum, "  Call CAL (""M"") "
 LineNum = LineNum + 1
 .InsertLines LineNum, "End If"
 LineNum = LineNum + 1
 .InsertLines LineNum, "End Sub"
 
 LineNum = LineNum + 1
 .InsertLines LineNum, "Private Sub CAL(Rn)"
 LineNum = LineNum + 1
 .InsertLines LineNum, " Sheet6.Cells(7, 8) = ""=OutPut!"" + Rn + ""22"""
 LineNum = LineNum + 1
 .InsertLines LineNum, "Sheet6.Cells(10, 8) = ""=-1*OutPut!"" + Rn + ""40"""
 LineNum = LineNum + 1
 .InsertLines LineNum, "Sheet6.Cells(32, 8) = ""=OutPut!"" + Rn + ""110"""
 LineNum = LineNum + 1
 .InsertLines LineNum, "Sheet6.Cells(38, 8) = ""=OutPut!"" + Rn + ""117"""
 LineNum = LineNum + 1
 .InsertLines LineNum, "Sheet6.Cells(42, 8) = ""=OutPut!"" + Rn + ""131"""
 LineNum = LineNum + 1
 .InsertLines LineNum, " Sheet6.Cells(48, 8) = ""=OutPut!"" + Rn + ""124"""
 LineNum = LineNum + 1
 .InsertLines LineNum, "Sheet6.Cells(17, 11) = ""=(OutPut!"" + Rn + ""44+OutPut!"" + Rn + ""46)*(1-AG54)"""
 LineNum = LineNum + 1
 .InsertLines LineNum, "Sheet6.Cells(24, 11) = ""=OutPut!"" + Rn + ""270+OutPut!"" + Rn + ""271"""
 LineNum = LineNum + 1
 .InsertLines LineNum, "End Sub"
 
End With
End Sub

'Private Sub UnprotectVBProject(wb As Workbook, ByVal Password As String)
'Dim vbProj As Object
'Set vbProj = wb.VBProject
'If vbProj.Protection <> 1 Then Exit Sub
'Set Application.VBE.ActiveVBProject = vbProj
'SendKeys "CapCap" & "~~"

'Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
'End Sub

'Private Sub ProtectVBProject(wb As Workbook, ByVal Password As String)
'Dim vbProj As Object
'Set vbProj = wb.VBProject
'If vbProj.Protection = 1 Then Exit Sub
'Set Application.VBE.ActiveVBProject = vbProj
'SendKeys "+{TAB}{RIGHT}%V{+}{TAB}CapCap{TAB}CapCap{ENTER}"
'Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
'wb.Save
'End Sub
Sub UnprotectVBProject()
 Dim vbProj As Object
 Set vbProj = ThisWorkbook.VBProject
 If vbProj.Protection <> 1 Then Exit Sub
  SendKeys "%{F11}"
  SendKeys "^r"
  SendKeys "{DOWN}"
  SendKeys "CapCap"
  SendKeys "{ENTER}"
End Sub

Sub ProtectVBProject()
 Dim vbProj As Object
 Set vbProj = ThisWorkbook.VBProject
 If vbProj.Protection = 1 Then Exit Sub
 On Error Resume Next
 Set Application.VBE.ActiveVBProject = vbProj
  DisplayAlerts = False
  SendKeys "+{TAB}"
  SendKeys "{RIGHT}"
  SendKeys "%V"
  SendKeys "{+}"
  SendKeys "{TAB}"
  SendKeys "CapCap"
  SendKeys "{TAB}"
  SendKeys "CapCap"
  SendKeys "{TAB}"
  SendKeys "{ENTER}"
  'ThisWorkbook.Save
  ThisWorkbook.Close savechanges:=True, Filename:=CapataTemplate1.xlsx, Routeworkbook:=CapataTemplate.xlsx
  SendKeys "%{F4}"
End Sub

Sub CmbBoxCreation()
 Dim oxlObj As OLEObject
  Set oxlObj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, left:=525, Top:=75, Width:=66, Height:=20)
  With oxlObj.Object
     .Font.size = 9
  End With
 oxlObj.ListFillRange = "BA2:BA12"
End Sub

Sub SelectSheet()
  ThisWorkbook.Close savechanges:=False
End Sub
                
Sub Rename()
  ActiveSheet.Name = ActiveSheet.Cells(2, 2).Text
End Sub
                
                
                


Attribute VB_Name = "Sheet1"
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
Private Sub Worksheet_Change(ByVal Target As Range)
   If ActiveSheet.Cells(2, 1).Text <> "" Then
   Dim sText As String
…

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