Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Planilha e janelas ...
 
Notifications
Clear all

Planilha e janelas com códigos VBA

 
2024 - VBA & Macros
Post Recente por H0LDYN 6 anos atrás
4 Posts
3 Usuários
0 Reactions
2,048 Visualizações
RSS
 H0LDYN
(@h0ldyn)
Posts: 6
Active Member
Topic starter
 

Boa tarde amigos,
Sou novo aqui e tenho uma planilha com alguns códigos VBA, estou aprendendo tudo aqui com vocês
Queria agradecer pela ajuda e se possível me ajudar a entender algumas coisas que ainda tenho dúvida
1) Queria saber como é feita a ordem das textbox1,2... pois quando dou TAB ele pula as caixas, mesmo estando na ordem.
Este é o mais complicado e queria saber se é possível
2) Botão "editar" na sheets("DADOS") precisava copiar o botão "editar" para linha abaixo e colocar algumas fórmulas em certas colunas (só na linha inserida) ex: SOMA...
3) Preciso definir uma área de impressão conforme as checkbox forem marcados ele imprime, os que não forem serão ocultados (só colunas).

Aqui está a planilha:
https://mega.nz/#!pgAkFAQQ!LqvnORX3TFkY ... 2-soqJbuN0

Se poderem me ajudar a compreender esses códigos serei muito grato a vocês!!!

 
Postado : 17/12/2019 3:58 pm
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

H0LDYN,

Bom dia!

Enviei mensagem particular para a tua caixa postal de mensagens (MP) aqui do fórum.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 18/12/2019 9:15 am
 LaerteB
(@laerteb)
Posts: 67
Trusted Member
 

Bom dia, HOLDYN

Amigo consegui resolver a sua terceira questão ;) ... abaixo os códigos para serem inseridos no
UserForm "frmPrintRelatorio" :

Código para o Botão "Imprimir" com ajuste automático da página:

Private Sub CommandButton1_Click()

Sheets("RELATORIO").Select
   'Ajuste da Página para impressão em .pdf*************************
With ActiveWorkbook.Sheets("RELATORIO").PageSetup
 .LeftHeader = ""
 .CenterHeader = ""
 .RightHeader = ""
 .LeftFooter = ""
 .CenterFooter = ""
 .RightFooter = ""
 .PrintQuality = 600
 .CenterHorizontally = True
 .CenterVertically = False
 .Orientation = xlLandscape
 .Draft = False
 .PaperSize = xlPaperA4
 .FirstPageNumber = xlAutomatic
 .Order = xlDownThenOver
 .BlackAndWhite = False
 .Zoom = False
 .FitToPagesWide = 1
 .FitToPagesTall = False
 End With
'**************************************************************
  ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

End Sub

Código para o Botão "Gerar PDF" com os ajustes automático da página:

Private Sub CommandButton2_Click()

Dim ws As Workbook
Dim Rl As String
Dim Dl As String
Dim Ultlin As Long
Dim Ultcol As Long
Dim pas

Set ws = ActiveWorkbook
Rl = "RELATORIO"
Dl = "DADOS"
                                                                                
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Application.DisplayAlerts = False

ws.Sheets(Rl).Cells.Clear 'limpa a Sheet inteira
Ultlin = ActiveSheet.Cells.SpecialCells(xlLastCell).Row

 If Me.CheckBox1.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("A1:A" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
   ws.Sheets(Rl).Range("A1").Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox2.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("B1:B" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox3.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("C1:C" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox4.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("D1:D" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox5.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("E1:E" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox6.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("F1:F" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox7.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("G1:G" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox8.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("H1:H" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox9.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("I1:I" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox10.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("J1:J" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox11.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("K1:K" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If
 If Me.CheckBox12.Value = True Then
   ws.Sheets(Dl).Select
   ws.Sheets(Dl).Range("L1:L" & Ultlin).Select
   Application.CutCopyMode = False
   Selection.Copy
   ws.Sheets(Rl).Select
  Ultcol = Sheets(Rl).Cells(1, Sheets(Rl).Columns.Count).End(xlToLeft).Column + 1
   ws.Sheets(Rl).Cells(1, Ultcol).Select
   Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteColumnWidths
   ws.Sheets(Rl).Range("A1").Select
 End If

'Ajuste da Página para salvamento em .pdf**********************
With ActiveWorkbook.Sheets(Rl).PageSetup
 .LeftHeader = ""
 .CenterHeader = ""
 .RightHeader = ""
 .LeftFooter = ""
 .CenterFooter = ""
 .RightFooter = ""
 .PrintQuality = 600
 .CenterHorizontally = True
 .CenterVertically = False
 .Orientation = xlLandscape
 .Draft = False
 .PaperSize = xlPaperA4
 .FirstPageNumber = xlAutomatic
 .Order = xlDownThenOver
 .BlackAndWhite = False
 .Zoom = False
 .FitToPagesWide = 1
 .FitToPagesTall = False
 End With
'*****************************************************************
If Sheets(Rl).Range("A1:A2") <> "" Then
 pas = Application.GetSaveAsFilename(InitialFileName:="Teste.pdf", _
         FileFilter:="PDF files, *.pdf", _
         Title:="Save PDF File")

    If TypeName(pas) = "Boolean" Then
     Else
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=pas, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        End If

Else
  MsgBox "Não existe dados para ser gerar o Relatório." & vbCr & _
  "Marque algum item ou itens para criá-lo."
   Exit Sub
   
End If

   Set ws = Nothing
   
   MsgBox "Criado arquivo PDF.", vbOKOnly
   
    Me.CommandButton1.Enabled = True

   Application.CutCopyMode = False
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True

End Sub

'Código para o Botão "Imprimir", que ficar desativado até ser gerado o PDF:

Private Sub UserForm_Initialize()

 Me.CommandButton1.Enabled = False

End Sub

Obs: não optei para ocultar colunas na sheet "DADOS", por questões praticas e funcionais; desta forma criei uma nova
sheet "RELATORIO" :D .

Verifique se era o que queria para a questão nº 3 :) ..

Para a 2ª questão estou esperando uma melhor informação sobre o seu objetivo, pois não entendi o
que quer fazer :? , ainda aguardando a sua resposta para esta questão ;) ..

Espero que ficou de fácil entendimento e se tiver alguma dúvida em relação a esses códigos acima é só informar
que analisarei :D ..

Editado um trecho do código para o Botão "Gerar PDF" em 19/12/2019 às 14:20hs que gera um erro;
veja a seguir a correção :

Substituir este trecho abaixo:

If Sheets(Rl).Range("A1:A2") <> "" Then

Por este abaixo:

If Sheets(Rl).Range("A1") <> "" Then

Qualquer coisa estamos aqui ;)

Aguardando sua resposta e seu Feed Back(é muito importante) ... se foi útil, não esqueça de clicar na "mãozinha" :D

LaerteB :D

 
Postado : 19/12/2019 7:51 am
 H0LDYN
(@h0ldyn)
Posts: 6
Active Member
Topic starter
 

Boa tarde LaerteB, cara você é um deus das planilhas tenho que te agradecer...

Na real a 2 questão não vou precisar, estou tentando elaborar algo melhor,
pois minha ideia é fazer tudo com as UserForm e módulos.
2) A segunda questão é fazer algo para editar os registros e negociar o valor da dívida (ir sendo descontado)
Eu fiz a janela com as edições necessárias, estou estudando agora como fazer para pegar os dados da célula selecionada
e jogar naquela janela para alterações...
A sua solução para terceira questão foi genial, estava com aquele erro que você citou e já solucionou, tenho que te agradecer muito pela tua atenção

Vou fazer novo upload do arquivo pois tenho mais conteúdo.
https://mega.nz/#!00w0lCJa!EYeDIqvVSrmr ... bdwHN-7zuE

 
Postado : 20/12/2019 2:27 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico