Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "EstaPastaDeTrabalho"
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_BeforeClose(Cancel As Boolean)
totrows = Worksheets("EXTRATO").Cells(Rows.Count, "B").End(xlUp).Row
If Worksheets("EXTRATO").Cells(Rows.Count, "B").End(xlUp).Row < 3 Then
Worksheets("SN").Range("A1:A8").ClearContents
Worksheets("SN").Range("B1").ClearContents
End If
End Sub

Private Sub Workbook_Open()
If Worksheets("SN").Cells(1, "A").Value = "" Then
sn = Round((Sqr((Year(Date) + 1) * (Month(Date) + 1) * (Day(Date) + 1) * Sqr(Hour(Time) + 1) * Sqr(Minute(Time) + 1) * (Second(Time) + 1) * 12345678))) + 10 ^ 7
For n = 1 To 8
Worksheets("SN").Cells(n, "A") = Mid(CStr(sn), n, 1)
Worksheets("SN").Cells(n, "AA") = Mid(CStr(sn), n, 1)
Next n
Worksheets("SN").Cells(1, "B") = ""
Worksheets("SN").Cells(2, "B") = CDate(DateSerial(2000, 1, 1))
End If

sn = CDbl(Worksheets("SN").Cells(1, "A"))
For n = 2 To 8
sn = CDbl(CStr(sn) + CStr(Worksheets("SN").Cells(n, "A")))
Next n
pwd = CStr(Round((Sqr(sn / (10 ^ 10 * Sqr(2))) * 13 ^ 8), 0))
mensagem = "Você excedeu o limite de operações da versão Trial."

passoapasso = False
End Sub


Attribute VB_Name = "Planilha1"
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_BeforeDelete()

If MsgBox("Esta aba não deve ser excluída e nem renomeada! Não salvar o arquivo ou será necessária a restauração por um arquivo novo!", vbCritical) = vbOK Then
Exit Sub
End If

End Sub

Attribute VB_Name = "Restaurar"
Attribute VB_Base = "0{E68DD1ED-F24E-4267-BBCD-A4C3FB16373D}{B54D4463-F3E0-4F9D-8002-92AEFDD95E80}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Dim ws1 As Worksheet
Dim totrows1 As Long
Dim totrows2 As Long
Dim totrows3 As Long
Dim z As Long
Dim z_nota As String

Private Sub bt_desvinc_Click()

xdata = Date
Call desvincular_notas

End Sub



Private Sub apagar_proventos()

totrows = Worksheets("PROVENTOS").Cells(Rows.Count, "A").End(xlUp).Row
If totrows < 3 Then
totrows = 3
End If
rngaddress = Cells(3, 1).Address & ":" & Cells(totrows, 7).Address
Worksheets("PROVENTOS").Range(rngaddress).Delete

End Sub


Private Sub apagar_corretoras()

totrows = Worksheets("CORRETORAS").Cells(Rows.Count, "A").End(xlUp).Row
If totrows < 2 Then
totrows = 2
End If
rngaddress = Cells(2, 1).Address & ":" & Cells(totrows, 1).Address
Worksheets("CORRETORAS").Range(rngaddress).ClearContents

End Sub

Private Sub apagar_notas()

totrows = Worksheets("EXTRATO").Cells(Rows.Count, "A").End(xlUp).Row
If totrows < 3 Then
totrows = 3
End If
rngaddress = Cells(3, 1).Address & ":" & Cells(totrows, 15).Address
Worksheets("EXTRATO").Range(rngaddress).Delete

totrows = Worksheets("OPERAÇÕES").Cells(Rows.Count, "F").End(xlUp).Row
If totrows < 3 Then
totrows = 3
End If
rngaddress = Cells(3, 6).Address & ":" & Cells(totrows, 7).Address
Worksheets("OPERAÇÕES").Range(rngaddress).ClearContents

If MsgBox("Notas desvinculadas com sucesso! Proceder com exclusão das operações? ", vbOKCancel) = vbOK Then
Call apagar_notas_salvas
Call apagar_operações
End If

End Sub

Private Sub apagar_operações()

totrows = Worksheets("OPERAÇÕES").Cells(Rows.Count, "A").End(xlUp).Row
If totrows < 3 Then
totrows = 3
End If
rngaddress = Cells(3, 1).Address & ":" & Cells(totrows, 7).Address
Call reset
Worksheets("OPERAÇÕES").Range(rngaddress).ClearContents

End Sub

Private Sub apagar_notas_salvas()

totrows = Worksheets("NOTAS").Cells(Rows.Count, "A").End(xlUp).Row
If totrows < 3 Then
totrows = 3
End If
rngaddress = Cells(3, 1).Address & ":" & Cells(totrows, 22).Address
Worksheets("NOTAS").Range(rngaddress).ClearContents

End Sub

Private Sub reset()

sn = Round((Sqr((Year(Date) + 1) * (Month(Date) + 1) * (Day(Date) + 1) * Sqr(Hour(Time) + 1) * Sqr(Minute(Time) + 1) * (Second(Time) + 1) * 12345678))) + 10 ^ 7
For n = 1 To 8
Worksheets("SN").Cells(n, "A") = Mid(CStr(sn), n, 1)
Next n
Worksheets("SN").Cells(1, "B") = ""

End Sub

Private Sub bt_notas_Click()

If MsgBox("Esta operação não poderá ser revertida, você deseja continuar?", vbOKCancel) = vbOK Then
Call apagar_notas
MsgBox "Lançamentos excluídos com sucesso!"
End If


End Sub

Private Sub bt_notas_salvas_Click()

MsgBox "Ao excluir as notas salvas, as informações de IRRF Day-Trade serão perdidas e não serão computadas na consolidação do imposto. Essa operação não é recomendada!"

If MsgBox("Esta operação não poderá ser revertida, você deseja continuar?", vbOKCancel) = vbOK Then
Call apagar_notas_salvas
MsgBox "Notas salvas excluídas com sucesso!"
End If

End Sub


Private Sub bt_proventos_Click()

If MsgBox("Esta operação não poderá ser revertida, você deseja continuar?", vbOKCancel) = vbOK Then
Call apagar_proventos
MsgBox "Proventos excluídos com sucesso!"
End If

End Sub

Private Sub bt_corretoras_Click()

If MsgBox("Esta operação não poderá ser revertida, você deseja continuar?", vbOKCancel) = vbOK Then
Call apagar_corretoras
MsgBox "Corretoras excluídas com sucesso!"
End If

End Sub

Private Sub bt_selecionar_Click()

If MsgBox("ATENÇÃO!! A restauração vai atualizar a chave de ativação com a chave da planilha selecionada! Utilize esse procedimetno para atualizar a versão sem perder a sua chave.", vbOKCancel) = vbCancel Then
Exit Sub
End If
MsgBox "Devido aos novos recursos desta versão, alguns campos poderão ficar em branco. Ex: Corretoras. Porém não deverão prejudicar o funcionamento da mesma."
MsgBox "Selecione uma planilha para restaurar o banco de dados."

Dim xFileDlg As FileDialog
Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
xFileDlg.Filters.Add "Arquivos XLSM", "*.xlsm", 1

If xFileDlg.Show = True Then
   xfile = xFileDlg.SelectedItems(1)
Else
   MsgBox "Você deve especificar um arquivo excel válido!" & vbCrLf & vbCrLf & "Clique em OK para sair.", vbCritical, "Obrigatório selecionar uma pasta."
   Exit Sub
End If

If MsgBox("Atenção!! Os dados DESTA PLANILHA serão APAGADOS e substituidos com os dados da PLANILHA SELECIONADA. Este processo não pode ser revertido. Você deseja continuar?", vbOKCancel) = vbOK Then
bt_tudo_Click
Else
MsgBox "Restauração cancelada."
Exit Sub
End If

Call update

For n = 1 To Worksheets("OPERAÇÕES").Cells(Rows.Count, "A").End(xlUp).Row
If IsNumeric(Worksheets("OPERAÇÕES").Cells(n, "G")) = True Then
Worksheets("OPERAÇÕES").Cells(n, "G").ClearContents
End If
Next n

Worksheets("OPERAÇÕES").Cells(1, "G").Value = "CORRETORA"
Worksheets("OPERAÇÕES").Columns(8).EntireColumn.ClearContents
Worksheets("OPERAÇÕES").Columns(9).EntireColumn.ClearContents
Worksheets("OPERAÇÕES").Columns(10).EntireColumn.ClearContents

Worksheets("EXTRATO").Cells(1, "K").Value = "IRRF"
Worksheets("EXTRATO").Cells(1, "L").Value = "CUSTOS"
Worksheets("EXTRATO").Cells(1, "O").Value = "RESULTADO BRUTO"

Unload Me

End Sub

Private Sub update()

Dim KeyCells As Range
Dim Sheet1, Sheet2 As Worksheet
Dim CellChanged As Integer
Dim Path, File As String
Dim LastRow As Long
Dim wbthis As Workbook
Dim wbtarget As Workbook
Dim totrows As Long

On Error GoTo erro
Path = xfile 'Edit Path File2
File = Left(Right$(Path, Len(Path) - InStrRev(Path, "\")), Len(Right$(Path, Len(Path) - InStrRev(Path, "\"))) - 4)

Set wbthis = ActiveWorkbook
Workbooks.Open (Path)
Set wbtarget = ActiveWorkbook

On Error Resume Next


totrows = wbtarget.Sheets("EXTRATO").Cells(Rows.Count, "B").End(xlUp).Row
If totrows < 3 Then totrows = 3
rngaddress = Cells(3, 1).Address & ":" & Cells(totrows, 15).Address
wbtarget.Sheets("EXTRATO").Range(rngaddress).Copy Destination:=wbthis.Sheets("EXTRATO").Cells(3, 1)

totrows = wbtarget.Sheets("PROVENTOS").Cells(Rows.Count, "B").End(xlUp).Row
If totrows < 3 Then totrows = 3
rngaddress = Cells(3, 1).Address & ":" & Cells(totrows, 7).Address
wbtarget.Sheets("PROVENTOS").Range(rngaddress).Copy Destination:=wbthis.Sheets("PROVENTOS").Cells(3, 1)

wbtarget.Sheets("DADOS").Cells(2, "H").Copy Destination:=wbthis.Sheets("DADOS").Cells(2, "H")
wbtarget.Sheets("DADOS").Cells(2, "I").Copy Destination:=wbthis.Sheets("DADOS").Cells(2, "I")
wbtarget.Sheets("DADOS").Cells(2, "J").Copy Destination:=wbthis.Sheets("DADOS").Cells(2, "J")

wbtarget.Sheets("OPERAÇÕES").Cells.Copy Destination:=wbthis.Sheets("OPERAÇÕES").Cells
wbtarget.Sheets("NOTAS").Cells.Copy Destination:=wbthis.Sheets("NOTAS").Cells
wbtarget.Sheets("CORRETORAS").Cells.Copy Destination:=wbthis.Sheets("CORRETORAS").Cells

'VERIFICAR BLACKLIST
sn = CDbl(wbtarget.Worksheets("SN").Cells(1, "A"))
For n = 2 To 8
sn = CDbl(CStr(sn) + CStr(wbtarget.Worksheets("SN").Cells(n, "A")))
Next n

totrows = wbthis.Sheets("BLACKLIST").Cells(Rows.Count, "A").End(xlUp).Row
For n = 2 To totrows
If CStr(wbthis.Sheets("BLACKLIST").Cells(n, "A")) = CStr(sn) Then
wbtarget.Worksheets("SN").Range("A1:A8").ClearContents
wbtarget.Worksheets("SN").Range("B1") = "Cancelada"
wbtarget.Save
Exit For
End If
Next n
'FIM VERIFICAÇÃO

'COPIA A ABA SN
wbtarget.Sheets("SN").Cells.Copy Destination:=wbthis.Sheets("SN").Cells

wbtarget.Activate

MsgBox "Leitura do da planilha realizada com sucesso!" & vbNewLine & vbNewLine & "As planilhas de impostos deverão ser geradas novamente."
wbtarget.Close SaveChanges:=False

wbthis.Activate

  Dim Rng As Range
  On Error Resume Next
  Set Rng = Range("t_extrato[[DATA]]").SpecialCells(xlCellTypeBlanks)
  On Error GoTo 0
  If Not Rng Is Nothing Then
    Rng.Delete Shift:=xlUp
  End If
  
  If Worksheets("SN").Cells(2, "B") = "" Then Worksheets("SN").Cells(2, "B") = "01/01/2000"

On Error GoTo 0
Exit Sub

erro:
MsgBox "Falha na leitura do arquivo!"
On Error GoTo 0

End Sub

Private Sub bt_tudo_Click()

If MsgBox("Esta operação não poderá ser revertida, você deseja continuar?", vbOKCancel) = vbOK Then
Call apagar_notas
Call apagar_proventos
Call apagar_corretoras
Else
Exit Sub
End If

    With Worksheets("T_POS").ListObjects("t_posição")
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Delete
        End If
    End With
'Worksheets("T_POS").Cells(1, "B") = ""
Worksheets("T_POS").Cells(2, "B") = "01/01/2000"
Worksheets("T_POS").Cells(2, "J") = 0
Worksheets("T_POS").Cells(2, "K") = 0
Worksheets("T_POS").Cells(2, "L") = 0

Call update_powerquery
Call update_pivot
'Worksheets("INÍCIO").Cells(15, "D") = ""
Worksheets("SN").Cells(1, "B") = ""
Worksheets("SN").Cells(1, "C") = 1
Worksheets("SN").Cells(1, "D") = 1
Worksheets("SN").Cells(1, "E") = 1

MsgBox "Restauração de fábrica executada com sucesso com sucesso!"

End Sub


Private Sub UserForm_initialize()
Set ws1 = Worksheets("SN")

End Sub


Attribute VB_Name = "Planilha12"
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 = "Split_dt"
Attribute VB_Base = "0{817916FA-1710-489D-8D4A-C2498BDA8EC9}{FC2240B6-086C-4F77-A6F4-FA722365E55E}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Dim qt_total As Long

Private Sub bt_fechar_Click()

Unload Me

End Sub

Private Sub bt_separar_Click()

If Me.txt_qt_daytrade = "0" Or Me.txt_qt_swingtrade = "0" Then
MsgBox "A quantidade não pode ser 0"
Exit Sub
End If

qt_daytrade = Me.txt_qt_daytrade
qt_swingtrade = Me.txt_qt_swingtrade
Unload Me

End Sub

Private Sub txt_qt_daytrade_afterupdate()

On Error GoTo solver

If CDbl(txt_qt_daytrade.Value) < qt_total Then
Me.txt_qt_daytrade.Value = Format(CDbl(txt_qt_daytrade.Value), "0")
Me.txt_qt_swingtrade = qt_total - CDbl(txt_qt_daytrade.Value)
Me.bt_separar.SetFocus
Else
GoTo solver
End If

On Error GoTo 0

Exit Sub

solver:
Me.txt_qt_daytrade.Value = qt_daytrade
Me.txt_qt_swingtrade = qt_swingtrade
On Error GoTo 0

End Sub

Private Sub txt_qt_swingtrade_afterupdate()

On Error GoTo solver

If CDbl(txt_qt_swingtrade.Value) < qt_total Then
Me.txt_qt_swingtrade.Value = Format(CDbl(txt_qt_swingtrade.Value), "0")
Me.txt_qt_daytrade = qt_total - CDbl(txt_qt_swingtrade.Value)
Me.bt_separar.SetFocus
Else
GoTo solver
End If

On Error GoTo 0

Exit Sub

solver:
Me.txt_qt_swingtrade.Value = qt_swingtrade
Me.txt_qt_daytrade = qt_daytrade
On Error GoTo 0

End Sub

Private Sub UserForm_initialize()

Me.lb_dt.Caption = Replace(xativo, "(D)", "") & "(D)"
Me.lb_st.Caption = Replace(xativo, "(D)", "")

If qt_daytrade > 0 Then
Me.txt_qt_daytrade = qt_daytrade
Me.txt_qt_swingtrade = 0
qt_total = qt_daytrade
Else
Me.txt_qt_swingtrade = qt_swingtrade
Me.txt_qt_daytrade = 0
qt_total = qt_swingtrade
End If

End Sub

Attribute VB_Name = "Posicao"
Attribute VB_Base = "0{CF251103-AD07-405E-9A4F-4C8348AD9671}{23A1468F-F93A-4F85-9A13-1264123B50F0}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Dim n As Long
Dim Y As Long
Dim X As Long
Dim carteira As Double
Dim totrows As Long
Dim xcotacao As String

Private Sub bt_atualizar_Click()

Me.txt_var = Format(0, "#,##0.00%")
Me.txt_var_btc = Format(0, "#,##0.00%")

On Error Resume Next
Me.txt_carteira = Format(Worksheets("T_POS").Cells(1, "B"), "#,##0.00")
Me.txt_btc = Format(Worksheets("T_POS").Cells(1, "E"), "#,##0.00")
Me.txt_atual = Format(Worksheets("T_POS").Cells(1, "G"), "#,##0.00")
Me.txt_atual_btc = Format(Worksheets("T_POS").Cells(1, "I"), "#,##0.00")
Me.txt_gain = Format(Worksheets("T_POS").Cells(1, "G") - (Format(Worksheets("T_POS").Cells(1, "B"))), "#,##0.00")
Me.txt_gain_btc = Format(Worksheets("T_POS").Cells(1, "I") - (Format(Worksheets("T_POS").Cells(1, "E"))), "#,##0.00")
Me.txt_var = Format((Worksheets("T_POS").Cells(1, "G") - Worksheets("T_POS").Cells(1, "B")) / Abs(Worksheets("T_POS").Cells(1, "B")), "#,##0.00%")
Me.txt_var_btc = Format((Worksheets("T_POS").Cells(1, "I") - Worksheets("T_POS").Cells(1, "E")) / Abs(Worksheets("T_POS").Cells(1, "E")), "#,##0.00%")


totrows = Worksheets("T_POS").Cells(Rows.Count, "A").End(xlUp).Row
For n = 0 To Me.listbox_posição.ListCount - 1
For X = 1 To totrows
If Me.listbox_posição.List(n) = Worksheets("T_POS").Cells(X, "A") Then
Me.listbox_posição.List(n, 5) = Format(Worksheets("T_POS").Cells(X, "K"), "#,##0.000000")
Me.listbox_posição.List(n, 6) = Format(Worksheets("T_POS").Cells(X, "L"), "#,##0.00")
Me.listbox_posição.List(n, 7) = Format(Worksheets("T_POS").Cells(X, "M") + Worksheets("T_POS").Cells(X, "N"), "#,##0.00")
Me.listbox_posição.List(n, 8) = Format((Worksheets("T_POS").Cells(X, "M") + Worksheets("T_POS").Cells(X, "N")) / Abs(Worksheets("T_POS").Cells(X, "H")), "#,##0.00%")
End If
Next X
Next n

Call recalcular

On Error GoTo 0

End Sub

Private Sub bt_atualizar_tabelas_Click()
Call update_pivot
End Sub

Private Sub bt_bull_Click()

If Me.listbox_posição.ListCount = 0 Then
MsgBox "Não existem dados para exportar."
Exit Sub
End If

MsgBox "Você deve possuir o recurso DDE da Bull Tecnofinance INSTALADO e LOGADO na sua conta para utilizar essa função."

Dim wbthis As Workbook
Dim wbtarget As Workbook
Dim nome As String

Set wbthis = ActiveWorkbook
Set wbtarget = Workbooks.Add
'On Error GoTo create

Do
    fname = Application.GetSaveAsFilename
Loop Until fname <> False
fname = fname + "xlsx"
wbtarget.SaveAs Filename:=fname


For n = 2 To Me.listbox_posição.ListCount - 1 + 2
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 1) = "ATIVO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 2) = "POSIÇÃO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 3) = "PREÇO MÉDIO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 4) = "VALOR TOTAL"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 1) = Me.listbox_posição.List(n - 2, 0)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 2) = Me.listbox_posição.List(n - 2, 1)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 3) = CDbl(Me.listbox_posição.List(n - 2, 2))
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 3).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 4) = CDbl(Me.listbox_posição.List(n - 2, 3))
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 4).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 6) = "COTAÇÃO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 7) = "TOTAL"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 8) = "RESULTADO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 9) = "VARIAÇÃO"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 6).Formula = "=BULLDDE|ULT!" + Me.listbox_posição.List(n - 2, 0)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 6).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 7).Formula = ("=B" & n) & ("*F" & n)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 7).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 8).Formula = ("=G" & n) & ("-D" & n)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 8).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 9).Formula = ("=H" & n) & ("/D" & n)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 9).NumberFormat = "0.00%"

Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 11) = "FECH ANTERIOR"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 12) = "RESULTADO NO DIA"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 13) = "VARIAÇÃO NO DIA"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 11).Formula = "=BULLDDE|FCHANT!" + Me.listbox_posição.List(n - 2, 0)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 11).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 12).Formula = ("=(F" & n) & ("-K" & n) & (")*B" & n)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 12).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 13).Formula = ("=(F" & n) & ("/K" & n) & ")-1"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 13).NumberFormat = "0.00%"

Next n

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 1) = "Total em Carteira:"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 4).Formula = "=SUM(D2:D" & n & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 4).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 3, 1) = "Posição em:"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 3, 4) = Me.txt_data

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 7).Formula = "=SUM(G2:G" & n & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 7).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 8).Formula = "=SUM(H2:H" & n & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 8).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 9).Formula = ("=H" & (n + 1)) & ("/D" & (n + 1))
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 9).NumberFormat = "0.00%"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 12).Formula = "=SUM(L2:L" & n & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 12).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 12).Activate

Unload Me

End Sub

Private Sub bt_cotação_Click()

totrows = Worksheets("T_POS").Cells(Rows.Count, "A").End(xlUp).Row
For n = 0 To Me.listbox_posição.ListCount - 1
For X = 1 To totrows
If Me.txt_ativo = Worksheets("T_POS").Cells(X, "A") Then
Worksheets("T_POS").Cells(X, "K") = CDbl(Me.txt_cotação)
End If
Next X
Next n

bt_atualizar_Click

If Me.listbox_posição.ListIndex < Me.listbox_posição.ListCount - 1 Then
Me.listbox_posição.ListIndex = Me.listbox_posição.ListIndex + 1
ElseIf Me.listbox_posição.ListCount > 0 Then
Me.listbox_posição.ListIndex = 0
End If
Me.txt_cotação.SetFocus

End Sub

Private Sub bt_dashboard_Click()
Worksheets("POSIÇÃO").Activate
End Sub

Private Sub bt_data_Click()
Data.Show
Me.txt_data = xdata

Me.listbox_posição.Clear

Call preencher_ativos
Call preencher_posições

Call t_pos
bt_atualizar_Click

End Sub

Private Sub bt_exportar_Click()

If Me.listbox_posição.ListCount = 0 Then
MsgBox "Não existem dados para exportar."
Exit Sub
End If

Dim wbthis As Workbook
Dim wbtarget As Workbook
Dim nome As String

Set wbthis = ActiveWorkbook
Set wbtarget = Workbooks.Add

Do
    fname = Application.GetSaveAsFilename
Loop Until fname <> False
fname = fname + "xlsx"
wbtarget.SaveAs Filename:=fname

'BENS E DIREITOS
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 1) = "BENS E DIREITOS"
wbtarget.ActiveSheet.Range("A1:F1").Interior.ColorIndex = 15
Workbooks(wbtarget.Name).ActiveSheet.Cells(2, 1) = "ATIVO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(2, 2) = "CNPJ"
Workbooks(wbtarget.Name).ActiveSheet.Cells(2, 3) = "RAZÃO SOCIAL"
Workbooks(wbtarget.Name).ActiveSheet.Cells(2, 4) = "POSIÇÃO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(2, 5) = "PREÇO MÉDIO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(2, 6) = "VALOR TOTAL"
X = 3

For n = 0 To Me.listbox_posição.ListCount - 1

If CDbl(Me.listbox_posição.List(n, 1)) > 0 Then
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 1) = Me.listbox_posição.List(n, 0)

For Y = 1 To wbthis.Worksheets("DADOS").Range("A1").End(xlDown).Row
If UCase(Me.listbox_posição.List(n, 0)) = UCase(wbthis.Worksheets("DADOS").Cells(Y, 1)) Then
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 2) = wbthis.Worksheets("DADOS").Cells(Y, 2)
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 3) = wbthis.Worksheets("DADOS").Cells(Y, 3)
End If
Next Y

Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 4) = Me.listbox_posição.List(n, 1)
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 5) = CDbl(Me.listbox_posição.List(n, 2))
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 5).NumberFormat = "#,##0.000000"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 6) = CDbl(Me.listbox_posição.List(n, 3))
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 6).NumberFormat = "#,##0.00"

X = X + 1
End If

Next n

Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 1, 1) = "Total em Carteira:"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 1, 6).Formula = "=SUM(F3:F" & X & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 1, 6).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 2, 1) = "Posição em:"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 2, 6) = Me.txt_data

'DÍVIDAS E ÔNUS REAIS
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 4, 1) = "DÍVIDAS E ÔNUS REAIS"
wbtarget.ActiveSheet.Range(CStr("A" & CStr(X + 4) & ":F" & CStr(X + 4))).Interior.ColorIndex = 15
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 5, 1) = "ATIVO EMPRESTADO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 5, 2) = "CNPJ"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 5, 3) = "RAZÃO SOCIAL"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 5, 4) = "POSIÇÃO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 5, 5) = "PREÇO MÉDIO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 5, 6) = "VALOR TOTAL"
X = X + 7
x1 = X - 1

For n = 0 To Me.listbox_posição.ListCount - 1

If CDbl(Me.listbox_posição.List(n, 1)) < 0 Then
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 1) = Me.listbox_posição.List(n, 0)

For Y = 1 To wbthis.Worksheets("DADOS").Range("A1").End(xlDown).Row
If UCase(Left(Me.listbox_posição.List(n, 0), 4)) = Left(wbthis.Worksheets("DADOS").Cells(Y, 1), 4) Then
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 2) = wbthis.Worksheets("DADOS").Cells(Y, 2)
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 3) = wbthis.Worksheets("DADOS").Cells(Y, 3)
End If
Next Y

Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 4) = Me.listbox_posição.List(n, 1)
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 5) = CDbl(Me.listbox_posição.List(n, 2))
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 5).NumberFormat = "#,##0.000000"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 6) = CDbl(Me.listbox_posição.List(n, 3))
Workbooks(wbtarget.Name).ActiveSheet.Cells(X, 6).NumberFormat = "#,##0.00"

X = X + 1
End If

Next n

Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 1, 1) = "Total emprestado:"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 1, 6).Formula = "=SUM(F" & x1 & ":F" & X & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 1, 6).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 2, 1) = "Posição em:"
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 2, 6) = Me.txt_data

wbtarget.ActiveSheet.Columns("A:F").AutoFit

Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 4, 1) = "Disclaimer: as informações apresentadas podem não estar atualizadas ou de acordo com as necessidades do usuário."
Workbooks(wbtarget.Name).ActiveSheet.Cells(X + 5, 1) = "O usuário deve sempre confirmar antes de utilizar as mesmas."

Unload Me

End Sub

Private Sub bt_fechar_Click()
If Worksheets("T_POS").Cells(2, "E") = "NENHUM" Then
GoTo exits
End If

Dim Response As Integer
Response = MsgBox("Quebrar vínculos DDE? (Recomendado!!)", vbYesNoCancel + vbQuestion, "Quebrar Vínculos?")
Select Case Response
Case vbYes
Application.ScreenUpdating = False
Worksheets("T_POS").Columns(11).EntireColumn.Copy
Worksheets("T_POS").Columns(11).EntireColumn.PasteSpecial Paste:=xlPasteValues
Worksheets("T_POS").Cells(2, "E") = "NENHUM"
Application.CutCopyMode = False
Application.ScreenUpdating = True
Unload Me
Case vbNo
Unload Me
Case vbCancel
Exit Sub
End Select

exits:
Unload Me

End Sub

Private Sub bt_google_Click()

If Me.listbox_posição.ListCount = 0 Then
MsgBox "Não existem dados para exportar."
Exit Sub
End If


MsgBox "GOOGLE FINANCE: Para correta utilização, salvar a planilha gerada e realizar a importação para a ferramenta do Google Docs (Google Sheets)."

Dim wbthis As Workbook
Dim wbtarget As Workbook
Dim nome As String

Set wbthis = ActiveWorkbook
Set wbtarget = Workbooks.Add

Do
    fname = Application.GetSaveAsFilename
Loop Until fname <> False
fname = fname + "xlsx"
wbtarget.SaveAs Filename:=fname

For n = 2 To Me.listbox_posição.ListCount - 1 + 2
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 1) = "ATIVO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 2) = "POSIÇÃO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 3) = "PREÇO MÉDIO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 4) = "VALOR TOTAL"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 1) = Me.listbox_posição.List(n - 2, 0)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 2) = Me.listbox_posição.List(n - 2, 1)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 3) = CDbl(Me.listbox_posição.List(n - 2, 2))
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 3).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 4) = CDbl(Me.listbox_posição.List(n - 2, 3))
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 4).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 6) = "COTAÇÃO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 7) = "TOTAL"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 8) = "RESULTADO"
Workbooks(wbtarget.Name).ActiveSheet.Cells(1, 9) = "VARIAÇÃO"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 6).Formula = "=GOOGLEFINANCE(A" & n & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 6).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 7).Formula = ("=B" & n) & ("*F" & n)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 7).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 8).Formula = ("=G" & n) & ("-D" & n)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 8).NumberFormat = "#,##0.00"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 9).Formula = ("=H" & n) & ("/D" & n)
Workbooks(wbtarget.Name).ActiveSheet.Cells(n, 9).NumberFormat = "0.00%"

Next n

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 1) = "Total em Carteira:"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 4).Formula = "=SUM(D2:D" & n & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 4).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 3, 1) = "Posição em:"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 3, 4) = Me.txt_data

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 7).Formula = "=SUM(G2:G" & n & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 7).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 8).Formula = "=SUM(H2:H" & n & ")"
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 8).NumberFormat = "#,##0.00"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 9).Formula = ("=H" & (n + 1)) & ("/D" & (n + 1))
Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 1, 9).NumberFormat = "0.00%"

Workbooks(wbtarget.Name).ActiveSheet.Cells(n + 5, 1).Value = "ATENÇÃO: SALVAR E ABRIR ESTE ARQUIVO COM A FERRAMENTA DO GOOGLE DOCS (GOOGLE SHEETS) PARA OBTER AS COTAÇÕES."

Unload Me

End Sub

Private Sub bt_link_Click()


If Me.cb_dde.Value <> "NENHUM" Then
MsgBox "Cadastrado o serviço DDE " + Me.cb_dde.Value
Worksheets("T_POS").Cells(2, "E") = Me.cb_dde.Value
Call t_pos_dde
Else
If Worksheets("T_POS").Cells(2, "E") = "NENHUM" Then
MsgBox "Nenhum Link DDE cadastrado."
Worksheets("T_POS").Cells(2, "E") = Me.cb_dde.Value
Exit Sub
Else
MsgBox "Removendo o serviço DDE " + Worksheets("T_POS").Cells(2, "E")
Application.ScreenUpdating = False
Worksheets("T_POS").Columns(11).EntireColumn.Copy
Worksheets("T_POS").Columns(11).EntireColumn.PasteSpecial Paste:=xlPasteValues
Worksheets("T_POS").Cells(2, "E") = "NENHUM"
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
End If

bt_atualizar_Click
End Sub


Private Sub cb_dde_Change()

If Me.cb_dde.Value = "NENHUM" Then
Me.bt_link.Caption = "Remover Link"
Else
Me.bt_link.Caption = "Obter Link"
End If

End Sub

Private Sub listbox_posição_Change()

If Me.listbox_posição.ListCount = 0 Then
Exit Sub
End If


Me.txt_ativo = Me.listbox_posição.Value
Me.txt_cotação = Me.listbox_posição.List(Me.listbox_posição.ListIndex, 5)

End Sub

Private Sub listbox_posição_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

If Me.listbox_posição.ListCount > 0 Then
xativo = Me.listbox_posição.List(Me.listbox_posição.ListIndex, 0)
Histórico.Show
End If

End Sub

Private Sub txt_aportes_afterupdate()

On Error GoTo solver2

Me.txt_aportes.Value = Format(CDbl(Me.txt_aportes.Value), "#,##0.00")
Worksheets("T_POS").Cells(2, "J") = CDbl(Me.txt_aportes.Value)
MsgBox "Aportes salvos no banco de dados."
Call recalcular
On Error GoTo 0

Exit Sub

solver2:
Me.txt_aportes.Value = Worksheets("T_POS").Cells(2, "J")
On Error GoTo 0

End Sub


Private Sub txt_saldos_afterupdate()

On Error GoTo solver2

Me.txt_saldos.Value = Format(CDbl(Me.txt_saldos.Value), "#,##0.00")
Worksheets("T_POS").Cells(2, "K") = CDbl(Me.txt_saldos.Value)
MsgBox "Saldos salvos no banco de dados."
Call recalcular
On Error GoTo 0

Exit Sub

solver2:
Me.txt_saldos.Value = Worksheets("T_POS").Cells(2, "K")
On Error GoTo 0

End Sub

Private Sub txt_outros_afterupdate()

On Error GoTo solver2

Me.txt_outros.Value = Format(CDbl(Me.txt_outros.Value), "#,##0.00")
Worksheets("T_POS").Cells(2, "L") = CDbl(Me.txt_outros.Value)
MsgBox "Outros investimentos salvos no banco de dados."
Call recalcular
On Error GoTo 0

Exit Sub

solver2:
Me.txt_outros.Value = Worksheets("T_POS").Cells(2, "L")
On Error GoTo 0

End Sub

Private Sub txt_cotação_afterupdate()

On Error GoTo solver2

Me.txt_cotação.Value = Format(CDbl(Me.txt_cotação.Value), "#,##0.00")

On Error GoTo 0

Exit Sub

solver2:
Me.txt_cotação.Value = xcotacao
On Error GoTo 0

End Sub

Private Sub txt_cotação_Enter()
xcotacao = Me.txt_cotação

End Sub

…