Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 f2f00264e84676a9…

MALICIOUS

Office (OOXML)

2.86 MB Created: 2008-09-04 10:44:46 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2019-04-18
MD5: 2054579e6b10e3041b5b012f001d1dc0 SHA-1: ddcbb82f94559e49c0f5974b4bb494292b0bed9d SHA-256: f2f00264e84676a95ba5bead27f0d645df66603a0ba7d03e8e5b53d13bbf3fca
338 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File

The sample is an Excel macro-enabled workbook containing a Workbook_Open macro that executes obfuscated VBA code. This code utilizes WScript.Shell and cmd.exe to download and execute a second-stage payload from the IP address 190.7.27.69. The obfuscated shell command with a URL points to a suspicious executable, indicating a downloader or droppper functionality.

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 10 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) 321238 bytes
SHA-256: 01d385dc086056b6d4853eb61f3f4e55c0af3f20cdff25f3e14bb7f2bfddc1db
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 = True
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
ActiveWindow.DisplayGridlines = True
Application.DisplayStatusBar = True
Application.DisplayFullScreen = True
'Application.DisplayScrollBars = bscroll

ThisWorkbook.Saved = False
Application.DisplayAlerts = True
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.DisplayAlerts = False
  '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{4E06A1DC-6944-4262-9AF3-3FC372E93A35}{4B053BEA-2CFC-49CA-83D1-7C467800334E}"
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-Residencial Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Residencial"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Social Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Tarifa Social"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Resid Rural Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Resid Rural"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Social Rural Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Tarifa Social 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("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-Residencial Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Residencial"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Social Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Tarifa Social"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Resid Rural Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Resid Rural"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Social Rural Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Tarifa Social 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

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("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-Residencial Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Residencial"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Social Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Tarifa Social"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Resid Rural Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Resid Rural"
End If
''''''''''''''''''''''''''''''''''''''
If tarifa = "T1-Tarifa Social Rural Ahorro/2015 >20%" Then
Range("tarifa1").Value = "T1-Tarifa Social 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

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
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 864256 bytes
SHA-256: f7ec950a9b23bca1600cbe2320facd41e3bd3d41950b0212f1322cec15daab4f

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