Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 b8ed9c408b45775c…

MALICIOUS

Office (OOXML)

2.85 MB Created: 2008-09-04 10:44:46 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2019-03-10
MD5: 9eaaa5c9e341f204e630683258c15359 SHA-1: d788e9b732f6fb7956f0fb2a2a991583bb5af2ee SHA-256: b8ed9c408b45775c6da40ea2f888b5ba25d6830f6b555ade8bde451a192b127e
338 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1059.003 Windows Command Shell T1204.002 Malicious File

The sample is an Excel file containing obfuscated VBA macros that utilize WScript.Shell and cmd.exe to execute a PowerShell command. This command downloads and executes a second-stage payload from the URL http://190.7.27.69:83/dtym/simulador.xlsm. The Workbook_Open macro is triggered upon opening, initiating the malicious execution chain.

Heuristics 10

  • VBA project inside OOXML medium 7 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
    Shell "taskkill.exe /IM ""AcroRd32.exe"" /f", vbHide
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
    Dim wshShell
Set wshShell = CreateObject("WScript.Shell")
  • Obfuscated VBA Shell command with URL critical OLE_VBA_OBFUSCATED_SHELL_URL
    VBA macro invokes Shell with command text assembled through decoder or string-manipulation functions and includes a URL. This is a high-confidence downloader/dropper pattern, stronger than Shell or URL evidence on their own.
    Matched line in script
    Dim wshShell
Set wshShell = CreateObject("WScript.Shell")
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    Dim wshShell
Set wshShell = CreateObject("WScript.Shell")
  • cmd.exe reference in VBA high OLE_VBA_CMD
    cmd.exe reference in VBA
    Matched line in script
    ' Get Program Association Handle
Set oExec = wshShell.Exec("cmd.exe /c assoc " & ext)
strProg = oExec.StdOut.ReadLine()
  • 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()
  If Application.Name <> "Microsoft Excel" Then
  • Hidden worksheet (hidden) low OOXML_HIDDEN_SHEET
    Excel workbook contains 14 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 http://190.7.27.69:83/dtym/simulador.xlsm Referenced by macro
    • https://www.youtube.com/watch?v=FkjsuN2zqSUReferenced by macro

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) 318918 bytes
SHA-256: c6f2aa77bbc17ee02bef7850bf1f6333d616cd5770bb9252ddffb4cbd5daa88c
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "Hoja9"
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 = "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
Public bfichas As Boolean
Public btitulos As Boolean
Public bformula As Boolean
Public bcuadricula As Boolean
Public bestado As Boolean
Public bfullscreen As Boolean
Public bscroll As Boolean




Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim strProg
ThisWorkbook.Protect "ju4nc4r10$m4r14"
strProg = GetProgramPath(".pdf")
If strProg <> "" Then ' si encuentra una aplicacion pdf
  Dim bpath1 As String
  Dim bpath2 As String
  bpath1 = ThisWorkbook.Path & "\Calculo T-Residencial.pdf"
  bpath2 = ThisWorkbook.Path & "\Calculo Consumo.pdf"
  AnalizarArchivo (bpath1)
  AnalizarArchivo (bpath2)
End If
ActiveWindow.DisplayWorkbookTabs = bfichas
ActiveWindow.DisplayHeadings = btitulos
Application.DisplayFormulaBar = bformula
ActiveWindow.DisplayGridlines = bcuadricula
Application.DisplayStatusBar = bestado
Application.DisplayFullScreen = bfullscreen
Application.DisplayScrollBars = bscroll
Application.DisplayAlerts = False
ThisWorkbook.Saved = False
If Workbooks.Count = 1 Then
Application.Quit

End If
End Sub

Private Sub Workbook_Open()
  If Application.Name <> "Microsoft Excel" Then
  Application.Quit
  End If
  ActiveWindow.Zoom = 100
  bfichas = ActiveWindow.DisplayWorkbookTabs
  ActiveWindow.DisplayWorkbookTabs = True
  btitulos = ActiveWindow.DisplayHeadings
  bcuadricula = ActiveWindow.DisplayGridlines
  bestado = Application.DisplayStatusBar
  bformula = Application.DisplayFormulaBar
  bfullscreen = Application.DisplayFullScreen
  bscroll = Application.DisplayScrollBars
  
  ActiveWindow.DisplayWorkbookTabs = False 'Oculta las fichas de las hojas
  ActiveWindow.DisplayHeadings = False 'Oculta títulos
  Application.DisplayFormulaBar = False 'Oculta la barra de formulas
  ActiveWindow.DisplayGridlines = False 'Oculta las lineas de la cuadricula
  Application.DisplayStatusBar = False 'Oculta la barra de estado
  Application.DisplayFullScreen = True 'Ves pantalla completa
  Application.DisplayScrollBars = False
  Dim fechafin, fechaini, x, mensaje
  x = Worksheets.Count
  fechafin = Worksheets(5).Range("C1").Value
  fechaini = Worksheets(x).Range("B1").Value
  Worksheets(4).Unprotect "ju4nc4r10$m4r14"
    If Date > Worksheets(5).Range("C1").Value Then
  Worksheets(4).Range("C9").Value = "Descargar actualización haciendo click aqui"
  Worksheets(4).Hyperlinks.Add Range("C9"), "http://190.7.27.69:83/dtym/simulador.xlsm"
  Else
  mensaje = "Vigencia desde el " & fechaini & " al " & fechafin & Chr(10) & Chr(13) & "¡Programa Actualizado!"
   Worksheets(4).Range("C9").Hyperlinks.Delete
   Worksheets(4).Range("C9").Value = mensaje
  End If
  Worksheets(4).Protect "ju4nc4r10$m4r14"
End Sub

Function GetProgramPath(ext)
Dim strProg, strProgPath
Dim wshShell
Set wshShell = CreateObject("WScript.Shell")

' Get Program Association Handle
Set oExec = wshShell.Exec("cmd.exe /c assoc " & ext)
strProg = oExec.StdOut.ReadLine()
If strProg = "" Then
  GetProgramPath = ""
  Exit Function
End If
strProg = Split(strProg, "=")(1)
GetProgramPath = strProg
End Function
 

Attribute VB_Name = "Hoja8"
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 = "Hoja7"
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 = "Hoja6"
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 = "Hoja2"
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 = "Hoja3"
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 = "Hoja4"
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 = "Hoja5"
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 = "Hoja10"
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 = "ModuloCalendario"
Option Explicit
Option Private Module
Private SenalCambioMes As Long

Public Sub RecibeLaFecha(Dia As Long, Mes As Long, Ano As Long)

' minini, maxini, minfinal, maxfinal
    
    Dim FechaRecibida As Date
    FechaRecibida = VBA.DateSerial((VBA.CInt(Ano)), (VBA.CInt(Mes)), (VBA.CInt(Dia)))
    
'*****************************************************************************************
'************ingresando fecha medicion *****************************************************
      Dim top, energia
      top = Worksheets.Count
      energia = Range("energia").Value
      reset
      Range("energia").Value = energia
      simulador.cb1.Visible = False
      simulador.cb1.Clear
      simulador.cbimprimir.Visible = False
      simulador.lbinicio.Caption = "T.Mensual"
      simulador.lbmedicion.Caption = "T.Bimestral"
      simulador.ltarifa.Visible = False
      simulador.lcf.Visible = False
      simulador.lcostoenergia.Visible = False
      simulador.lcontribucion.Visible = False
      simulador.lfedeer.Visible = False
      simulador.ltasamuni.Visible = False
      simulador.liva.Visible = False
      simulador.lresultado.Visible = False
      
      If (FechaRecibida < Worksheets(5).Cells(1, 3)) Then
      
                 'asigno valor a finicio de acuerdo a cantidad de días seleccionados
                 If simulador.ob28.Value Then
                       If FechaRecibida - 28 >= Worksheets(top).Cells(1, 2) Then
                       Range("finicio").Value = FechaRecibida - 28
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 28
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 28
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob29.Value Then
                 If FechaRecibida - 29 >= Worksheets(top).Cells(1, 2) Then
                       Range("finicio").Value = FechaRecibida - 29
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 29
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 29
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob30.Value Then
                       If FechaRecibida - 30 >= Worksheets(top).Cells(1, 2) Then
                       Range("finicio").Value = FechaRecibida - 30
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 30
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 30
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob31.Value Then
                       If FechaRecibida - 31 >= Worksheets(top).Cells(1, 2) Then
                         Range("finicio").Value = FechaRecibida - 31
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 31
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 31
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob32.Value Then
                       If FechaRecibida - 32 >= Worksheets(top).Cells(1, 2) Then
                       Range("finicio").Value = FechaRecibida - 32
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 32
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 32
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob33.Value Then
                       If FechaRecibida - 33 >= Worksheets(top).Cells(1, 2) Then
                       Range("finicio").Value = FechaRecibida - 28
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 28
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 28
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob58.Value Then
                       If FechaRecibida - 58 >= Worksheets(top).Cells(1, 2) Then
                       Range("finicio").Value = FechaRecibida - 58
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 58
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 58
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob59.Value Then
                       If FechaRecibida - 59 >= Worksheets(top).Cells(1, 2) Then
                       Range("finicio").Value = FechaRecibida - 59
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 59
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 59
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob60.Value Then
                       If FechaRecibida - 60 >= Worksheets(top).Cells(1, 2) Then
                      Range("finicio").Value = FechaRecibida - 60
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 60
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 60
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob61.Value Then
                       If FechaRecibida - 61 >= Worksheets(top).Cells(1, 2) Then
                      Range("finicio").Value = FechaRecibida - 61
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 61
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 61
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob62.Value Then
                       If FechaRecibida - 62 >= Worksheets(top).Cells(1, 2) Then
                       Range("finicio").Value = FechaRecibida - 62
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 62
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 62
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                 If simulador.ob63.Value Then
                       If FechaRecibida - 63 >= Worksheets(top).Cells(1, 2) Then
                        Range("finicio").Value = FechaRecibida - 63
                       Range("fmedicion").Value = FechaRecibida
                       simulador.lbinicio.Caption = FechaRecibida - 63
                       simulador.lbmedicion.Caption = FechaRecibida
                       Range("totaldias").Value = 63
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
                 Else
                Range("fmedicion").Value = FechaRecibida
                simulador.lbmedicion.Caption = FechaRecibida
                simulador.lbinicio.Caption = ""
                 MsgBox ("seleccionar cantidad de días medidos")
                 
                 End If
                 End If
                 End If
                 End If
                 End If
                 End If
                 End If
                 End If
                 End If
                 End If
                 End If
                 End If
    
      ' si hay una fecha de inicio definida busca los cuadros vigentes
'      If Range("finicio").Value <> "" Then
'        buscarcuadros
'      End If
      '///////////////////////////////////////////////////////////////////
      
      Else
     MsgBox ("Fechas fuera del periodo de vigencia")
      End If
                  
                  





End Sub

'********************************** NO MODIFICAR SI NO SABE **********************************
'*************************************|||||||||||||||||||*************************************
'***************************************|||||||||||||||***************************************
'*****************************************|||||||||||*****************************************
'*******************************************|||||||*******************************************
Public Sub InicializaFormularioCalendario()
    SenalCambioMes = 1
    
    With frmCalendario.cboMes
        .AddItem 1
        .List(0, 1) = "enero"
        .AddItem 2
        .List(1, 1) = "febrero"
        .AddItem 3
        .List(2, 1) = "marzo"
        .AddItem 4
        .List(3, 1) = "abril"
        .AddItem 5
        .List(4, 1) = "mayo"
        .AddItem 6
        .List(5, 1) = "junio"
        .AddItem 7
        .List(6, 1) = "julio"
        .AddItem 8
        .List(7, 1) = "agosto"
        .AddItem 9
        .List(8, 1) = "septiembre"
        .AddItem 10
        .List(9, 1) = "octubre"
        .AddItem 11
        .List(10, 1) = "noviembre"
        .AddItem 12
        .List(11, 1) = "diciembre"
    End With
    
    frmCalendario.cboMes.ListIndex = VBA.Month(VBA.Date) - 1
    
    frmCalendario.spbAño.Value = VBA.Year(VBA.Date)
    
    frmCalendario.lblAno.Caption = VBA.Year(VBA.Date)
    
    Dim Ano As Long, Mes As Long
    Ano = VBA.Year(VBA.Date)
    Mes = VBA.Month(VBA.Date)
    Call ModuloCalendario.CargarLosDias(Ano, Mes)
    
    frmCalendario.lblHoy.Caption = VBA.Date
End Sub

Public Sub CargarLosDias(Ano As Long, Mes As Long)
    Dim FechaDelPrimerDia As Date
    Dim FechaDelUltimoDia As Date
    Dim DiaSemanaPrimerDia As Long
    Dim VariableControl As Control
    Dim Contador As Long
    
    FechaDelPrimerDia = VBA.DateSerial(Ano, Mes, 1)
    FechaDelUltimoDia = Application.WorksheetFunction.EoMonth(VBA.DateSerial(Ano, Mes, 1), 0)
    DiaSemanaPrimerDia = Application.WorksheetFunction.Weekday(FechaDelPrimerDia, 2)
    Contador = 1
    
    For Each VariableControl In frmCalendario.mrcDias.Controls
        VariableControl.Caption = "-"
        If VariableControl.Tag >= DiaSemanaPrimerDia And Contador <= VBA.Day(FechaDelUltimoDia) Then
            VariableControl.Caption = Contador
            Contador = Contador + 1
        End If
    Next VariableControl
End Sub

Public Sub CambioDeMes()
    If SenalCambioMes > 1 Then
        Dim MesEnElCombo As Long, AnoEnElLabel As Long
        
        If Not (IsNull(frmCalendario.cboMes.Value)) And Not (IsNull(frmCalendario.lblAno.Caption)) Then
            MesEnElCombo = VBA.CLng(frmCalendario.cboMes.Value)
            AnoEnElLabel = VBA.CLng(frmCalendario.lblAno.Caption)
            Call ModuloCalendario.DesmarcarDias
            Call ModuloCalendario.CargarLosDias(AnoEnElLabel, MesEnElCombo)
        End If
    End If
    SenalCambioMes = SenalCambioMes + 1
End Sub

Public Sub CambioDeAno()
    Dim MesEnElCombo As Long, AnoEnElLabel As Long
    
    frmCalendario.lblAno.Caption = frmCalendario.spbAño.Value
    
    MesEnElCombo = VBA.CLng(frmCalendario.cboMes.Value)
    AnoEnElLabel = VBA.CLng(frmCalendario.lblAno.Caption)
    Call ModuloCalendario.DesmarcarDias
    Call ModuloCalendario.CargarLosDias(AnoEnElLabel, MesEnElCombo)
    
End Sub

Public Sub UnClickEnHoyEs()
    Dim Mes As Long, Ano As Long
    Dim FechaActual As Date
    
    FechaActual = VBA.CDate(frmCalendario.lblHoy.Caption)
    Mes = VBA.CLng(VBA.Month(FechaActual))
    Ano = VBA.CLng(VBA.Year(FechaActual))
    
    frmCalendario.lblAno.Caption = Ano
    frmCalendario.cboMes.ListIndex = Mes - 1
    frmCalendario.spbAño.Value = Ano
    frmCalendario.spbAño.SetFocus
    
    Call ModuloCalendario.DesmarcarDias
    Call ModuloCalendario.CargarLosDias(Ano, Mes)
    
End Sub

Sub SalirConEscape()
    Unload frmCalendario
End Sub

Sub MarcarDia(ControlDeEtiqueta As Control)
    Call ModuloCalendario.DesmarcarDias
    ControlDeEtiqueta.Font.Bold = True
    ControlDeEtiqueta.ForeColor = VBA.RGB(255, 0, 0)
End Sub

Sub DesmarcarDias()
    Dim ControlEtiqueta As Control
    
    For Each ControlEtiqueta In frmCalendario.mrcDias.Controls
        ControlEtiqueta.Font.Bold = False
        ControlEtiqueta.ForeColor = VBA.RGB(0, 0, 0)
    Next ControlEtiqueta
End Sub

'*******************************************|||||||*******************************************
'*****************************************|||||||||||*****************************************
'***************************************|||||||||||||||***************************************
'*************************************||||||||||||||||||**************************************
'********************************** NO MODIFICAR SI NO SABE **********************************

' Nota del autor -----------------------------------------------------------------------------

' Creado por Andrés Rojas Moncada - Autor del canal Excel Hecho Fácil en YouTube

' Versión 1.0 - 20 de julio de 2015

' URL del canal: www.youtube.com/jarmoncada01

' Si quieres usarlo, solo copia y pega el presente módulo en conjunto con el UserForm y listo.

' Para ver algunos ejemplos sobre el uso de este calendario, observa este video.

' Enlace: |||||||||||||||||||| https://www.youtube.com/watch?v=FkjsuN2zqSU ||||||||||||||||||||

' ! Muchas gracias y espero lo disfruten ! ---------------------------------------------------



Attribute VB_Name = "simulador"
Attribute VB_Base = "0{8EA9EDFC-F685-4E90-A2EA-701CC9AC8983}{A412349C-33EE-4372-9D51-CD13A4C8ED78}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub bfecha1_Click()
  Load frmCalendario
  frmCalendario.Show
End Sub

Private Sub cb1_Change()

If Range("cuadro1").Value <> "" Then
Range("tarifa1").Value = ""
Range("tarifa2").Value = ""
Range("tarifa3").Value = ""
Dim tarifa, i, cuadro, ban

tarifa = simulador.cb1.Value
ban = False
'''''''busco si en cuadro 1 se encuentra la tarifa seleccionada
cuadro = Range("cuadro1").Value
For i = 3 To 25
Dim valor
valor = Worksheets(cuadro).Range("A" & i).Value

If tarifa = valor Then
Range("tarifa1").Value = tarifa
ban = True
Exit For

End If
Next
'''''''si no encontro la tarifa en el cuadro 1 analizo exepciones
If Not ban Then
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Residencial Ahorro/2015 10-20%" Then
Range("tarifa1").Value = "T1-Residencial"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Resid Rural Ahorro/2015 10-20%" Then
Range("tarifa1").Value = "T1-Resid Rural"
End If
'''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Rur Res con Act Prod Ahorro/2015 10-20%" Then
Range("tarifa1").Value = "T1-Rur Res con Act Prod"
End If
''''''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Residencial (ELECTRODEPENDIENTES) Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Tarifa Residencial (ELECTRODEPENDIENTES)"
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Rural (ELECTRODEPENDIENTES) Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Tarifa Rural (ELECTRODEPENDIENTES)"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
''''''''''''''''''''''''''''FIN TARIFA CUADRO1''''''''''''''''''''''''''''''''''

'''''''busco si en cuadro 2 se encuentra la tarifa seleccionada
If Range("cuadro2").Value <> "" Then
ban = False
'''''''busco si en cuadro 2 se encuentra la tarifa seleccionada
cuadro = Range("cuadro2").Value
For i = 3 To 25
valor = Worksheets(cuadro).Range("A" & i).Value
If tarifa = valor Then
Range("tarifa2").Value = tarifa
ban = True
Exit For
End If
Next
'''''''si no encontro la tarifa en el cuadro 2 analizo exepciones
If Not ban Then
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Residencial Ahorro/2015 10-20%" Then
Range("tarifa2").Value = "T1-Residencial"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Resid Rural Ahorro/2015 10-20%" Then
Range("tarifa2").Value = "T1-Resid Rural"
End If
'''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Rur Res con Act Prod Ahorro/2015 10-20%" Then
Range("tarifa2").Value = "T1-Rur Res con Act Prod"
End If
''''''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Residencial (ELECTRODEPENDIENTES) Ahorro/2015 >20%" Then
Range("tarifa2").Value = "T1-Tarifa Residencial (ELECTRODEPENDIENTES)"
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Rural (ELECTRODEPENDIENTES) Ahorro/2015 >20%" Then
Range("tarifa2").Value = "T1-Tarifa Rural (ELECTRODEPENDIENTES)"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End If

End If
''''''''''''''''''''''''''''FIN TARIFA CUADRO2''''''''''''''''''''''''''''''''''

'''''''busco si en cuadro 3 se encuentra la tarifa seleccionada
If Range("cuadro3").Value <> "" Then
ban = False
'''''''busco si en cuadro 2 se encuentra la tarifa seleccionada
cuadro = Range("cuadro3").Value
For i = 3 To 25
If tarifa = Worksheets(cuadro).Range("A" & i).Value Then
Range("tarifa3").Value = tarifa
ban = True
Exit For
End If
Next
'''''''si no encontro la tarifa en el cuadro 3 analizo exepciones
If Not ban Then
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Residencial Ahorro/2015 10-20%" Then
Range("tarifa3").Value = "T1-Residencial"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Resid Rural Ahorro/2015 10-20%" Then
Range("tarifa3").Value = "T1-Resid Rural"
End If
'''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Rur Res con Act Prod Ahorro/2015 10-20%" Then
Range("tarifa3").Value = "T1-Rur Res con Act Prod"
End If
''''''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Residencial (ELECTRODEPENDIENTES) Ahorro/2015 >20%" Then
Range("tarifa3").Value = "T1-Tarifa Residencial (ELECTRODEPENDIENTES)"
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Rural (ELECTRODEPENDIENTES) Ahorro/2015 >20%" Then
Range("tarifa3").Value = "T1-Tarifa Rural (ELECTRODEPENDIENTES)"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End If

End If
''''''''''''''''''''''''''''FIN TARIFA CUADRO3''''''''''''''''''''''''''''''''''
End If
calcular
simulador.energia.SetFocus
End Sub

Private Sub cb2_Change()
If Sheets(1).Range("tarifa1").Value <> "" Then
Sheets(1).Range("tasamuni").Value = simulador.cb2.Value / 100
Dim tasa, resultado
resultado = Sheets(1).Range("I29").Value
tasa = Sheets(1).Range("I27").Value
simulador.ltasamuni.Caption = "Tasa Municipal Max 16%     " & tasa
simulador.lresultado.Caption = "Total  $" & resultado
End If

End Sub

Private Sub cbimprimir_Click()
If Worksheets(1).Range("I21").Value <> "" Then
Dim strProg
strProg = GetProgramPath(".pdf")
ThisWorkbook.Unprotect "ju4nc4r10$m4r14"
Worksheets(1).Visible = True
Worksheets(1).Activate
            If strProg <> "" Then ' si encuentra una aplicacion pdf
            Dim bpath As String
            bpath = ThisWorkbook.Path & "\Calculo T-Residencial.pdf"
            AnalizarArchivo (bpath)            ' cierra el acrobat si esta abierto y borra si existe uno creado
            Worksheets(1).ExportAsFixedFormat Type:=xlTypePDF, filename:=bpath, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=True
            Else
            Unload simulador
            ActiveSheet.PrintPreview
            End If
Else
MsgBox ("Cargar Parámetros")
End If
Worksheets(1).Visible = False
Worksheets(4).Activate
ThisWorkbook.Protect "ju4nc4r10$m4r14"

End Sub

Private Sub CheckBox1_Click()

End Sub

Private Sub cm_Change()
If Sheets(1).Range("tarifa1").Value <> "" Then
If cm Then
Range("C.municipal").Value = 8.6956 / 100
simulador.cb2.Enabled = True
simulador.cb2.ListIndex = 16
Range("tasamuni").Value = simulador.cb2.Value / 100
Else
Range("C.municipal").Value = 0
Range("tasamuni").Value = 0
simulador.cb2.ListIndex = 0
simulador.cb2.Enabled = False

End If
Dim contribucion, resultado, feder, tasa, iva
resultado = Sheets(1).Range("I29").Value
contribucion = Sheets(1).Range("I23").Value
feder = Sheets(1).Range("I25").Value
tasa = Sheets(1).Range("I27").Value
iva = Sheets(1).Range("I28").Value
simulador.lcontribucion.Caption = "C. Municipal 8.6956%           " & contribucion
simulador.lfedeer.Caption = "Fedeer                                   " & feder
simulador.ltasamuni.Caption = "Tasa Municipal Max 16%     " & tasa
simulador.liva.Caption = "IVA 21-27%                          " & iva
simulador.lresultado.Caption = "Total  $" & resultado
End If

End Sub



Private Sub CommandButton1_Click()
reset
resetsim
End Sub

 Sub energia_Change()
Dim Consumo, i
Consumo = energia.Value

If Not IsNumeric(Consumo) Or InStr(1, energia.Text, ",") Then
     If Consumo <> "" Then
     Beep
     MsgBox ("             Error de Formato" + Chr(13) + Chr(10) + "Ingrese el consumo nuevamente")
     energia.Value = Null
     Range("energia").Value = ""
    ' Else
     'Range("energia").Value = Consumo
     End If

Else
Range("energia").Value = Consumo
End If
If Range("tarifa1").Value <> "" Then
resetcal
calcular
End If
End Sub
Private Sub ob28_Click()
Dim fmedicion, finicio, frango, top, energia
top = Worksheets.Count
frango = Worksheets(top).Range("B1").Value
fmedicion = Range("fmedicion").Value
energia = Range("energia").Value
reset
Range("energia").Value = energia
simulador.cb1.Visible = False
simulador.cb1.Clear
simulador.cbimprimir.Visible = False
simulador.lbinicio.Caption = "T.Mensual"
simulador.lbmedicion.Caption = "T.Bimestral"
simulador.ltarifa.Visible = False
simulador.lcf.Visible = False
simulador.lcostoenergia.Visible = False
simulador.lcontribucion.Visible = False
simulador.lfedeer.Visible = False
simulador.ltasamuni.Visible = False
simulador.liva.Visible = False
simulador.lresultado.Visible = False
If fmedicion <> "" Then
                       finicio = fmedicion - 28
                       If finicio >= frango Then
                       Range("finicio").Value = finicio
                       Range("fmedicion").Value = fmedicion
                       simulador.lbinicio.Caption = finicio
                       simulador.lbmedicion.Caption = fmedicion
                       Range("totaldias").Value = 28
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
Else
Load frmCalendario
frmCalendario.Show
End If
End Sub

Private Sub ob29_Click()
Dim fmedicion, finicio, frango, top, energia
top = Worksheets.Count
frango = Worksheets(top).Range("B1").Value
fmedicion = Range("fmedicion").Value
energia = Range("energia").Value
reset
Range("energia").Value = energia
simulador.cb1.Visible = False
simulador.cb1.Clear
simulador.cbimprimir.Visible = False
simulador.lbinicio.Caption = "T.Mensual"
simulador.lbmedicion.Caption = "T.Bimestral"
simulador.ltarifa.Visible = False
simulador.lcf.Visible = False
simulador.lcostoenergia.Visible = False
simulador.lcontribucion.Visible = False
simulador.lfedeer.Visible = False
simulador.ltasamuni.Visible = False
simulador.liva.Visible = False
simulador.lresultado.Visible = False
If fmedicion <> "" Then
                       finicio = fmedicion - 29
                       If finicio >= frango Then
                       Range("finicio").Value = finicio
                       Range("fmedicion").Value = fmedicion
                       simulador.lbinicio.Caption = finicio
                       simulador.lbmedicion.Caption = fmedicion
                       Range("totaldias").Value = 29
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
Else
Load frmCalendario
frmCalendario.Show
End If

End Sub
Private Sub ob30_Click()
Dim fmedicion, finicio, frango, top, energia
top = Worksheets.Count
frango = Worksheets(top).Range("B1").Value
fmedicion = Range("fmedicion").Value
energia = Range("energia").Value
reset
Range("energia").Value = energia
simulador.cb1.Visible = False
simulador.cb1.Clear
simulador.cbimprimir.Visible = False
simulador.lbinicio.Caption = "T.Mensual"
simulador.lbmedicion.Caption = "T.Bimestral"
simulador.ltarifa.Visible = False
simulador.lcf.Visible = False
simulador.lcostoenergia.Visible = False
simulador.lcontribucion.Visible = False
simulador.lfedeer.Visible = False
simulador.ltasamuni.Visible = False
simulador.liva.Visible = False
simulador.lresultado.Visible = False
If fmedicion <> "" Then
                       finicio = fmedicion - 30
                       If finicio >= frango Then
                       Range("finicio").Value = finicio
                       Range("fmedicion").Value = fmedicion
                       simulador.lbinicio.Caption = finicio
                       simulador.lbmedicion.Caption = fmedicion
                       Range("totaldias").Value = 30
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
Else
Load frmCalendario
frmCalendario.Show
End If


End Sub

Private Sub ob31_Click()
Dim fmedicion, finicio, frango, top, energia
top = Worksheets.Count
frango = Worksheets(top).Range("B1").Value
fmedicion = Range("fmedicion").Value
energia = Range("energia").Value
reset
Range("energia").Value = energia
simulador.cb1.Visible = False
simulador.cb1.Clear
simulador.cbimprimir.Visible = False
simulador.lbinicio.Caption = "T.Mensual"
simulador.lbmedicion.Caption = "T.Bimestral"
simulador.ltarifa.Visible = False
simulador.lcf.Visible = False
simulador.lcostoenergia.Visible = False
simulador.lcontribucion.Visible = False
simulador.lfedeer.Visible = False
simulador.ltasamuni.Visible = False
simulador.liva.Visible = False
simulador.lresultado.Visible = False
If fmedicion <> "" Then
                       finicio = fmedicion - 31
                       If finicio >= frango Then
                       Range("finicio").Value = finicio
                       Range("fmedicion").Value = fmedicion
                       simulador.lbinicio.Caption = finicio
                       simulador.lbmedicion.Caption = fmedicion
                       Range("totaldias").Value = 31
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
Else
Load frmCalendario
frmCalendario.Show
End If


End Sub

Private Sub ob32_Click()
Dim fmedicion, finicio, frango, top, energia
top = Worksheets.Count
frango = Worksheets(top).Range("B1").Value
fmedicion = Range("fmedicion").Value
energia = Range("energia").Value
reset
Range("energia").Value = energia
simulador.cb1.Visible = False
simulador.cb1.Clear
simulador.cbimprimir.Visible = False
simulador.lbinicio.Caption = "T.Mensual"
simulador.lbmedicion.Caption = "T.Bimestral"
simulador.ltarifa.Visible = False
simulador.lcf.Visible = False
simulador.lcostoenergia.Visible = False
simulador.lcontribucion.Visible = False
simulador.lfedeer.Visible = False
simulador.ltasamuni.Visible = False
simulador.liva.Visible = False
simulador.lresultado.Visible = False
If fmedicion <> "" Then
                       finicio = fmedicion - 32
                       If finicio >= frango Then
                       Range("finicio").Value = finicio
                       Range("fmedicion").Value = fmedicion
                       simulador.lbinicio.Caption = finicio
                       simulador.lbmedicion.Caption = fmedicion
                       Range("totaldias").Value = 32
                       buscarcuadros
                       Else
                       MsgBox ("Fechas fuera del periodo de vigencia")
                       End If
Else
Load frmCalendario
frmCalendario.Show
End If
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 842240 bytes
SHA-256: 437e9fcc61837c36da980729c43d55b07e41cfaea081b6916a8120d652f50553

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