Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Imprimir página se encontra palavra específica

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
andril
Acabou de chegar
Acabou de chegar
Mensagens: 9
Registrado em: Sáb Dez 28, 2019 5:23 am

Imprimir página se encontra palavra específica

Mensagem por andril »

Boa tarde rapazes!

Sou novo por aqui, mas já consulto os posts há bastante tempo pra personalizar minhas planilhas.

Tenho uma macro grande que gera um conjunto de páginas impressas, e dentro desse código eu precisava adicionar uma função, que, caso no range D8:D263 da planilha LISTAGEM, estiver escrito a palavra "CUBAR", ao menos uma vez, a planilha ROMCUB fosse impressa.

Já tentei usar vários códigos, mas como tenho que colocar ele dentro de outra macro, tem algo que não está fechando.

O código que utilizo hoje:

Sub imprimeintervalocomdados()

Dim meuIntervalo As String
Dim LR As Long
Dim i As Long
Dim meuIntervalo2 As String
Dim LR2 As Long
Dim i2 As Long

If MsgBox("IMPRIMIR?", vbYesNo) = vbYes Then

If Worksheets("LISTAGEM").Range("C4").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

If Worksheets("LISTAGEM").Range("C5").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

If Worksheets("LISTAGEM").Range("C6").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

If Worksheets("LISTAGEM").Range("E5").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

If Worksheets("LISTAGEM").Range("E6").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

With ThisWorkbook
.Activate
With .Worksheets("IMPRESSAO")

.Activate
LR = .Cells(.Rows.Count, 1).End(xlUp).Row

For i = 1 To LR

If .Cells(i, "A").Value = "" And _
.Cells(i, "A").HasFormula And _
Not .Cells(i, "A").MergeCells Then
Exit For
End If

Next i

meuIntervalo = .Range("C" & i).Address
.PageSetup.PrintArea = "$A$1:" & meuIntervalo
.PrintOut

End With
End With

'Nova função seria aqui

With ThisWorkbook
.Activate
With .Worksheets("ROMANEIO")

.Activate
LR2 = .Cells(.Rows.Count, 1).End(xlUp).Row

For i2 = 1 To LR2

If .Cells(i2, "A").Value = "" And _
.Cells(i2, "A").HasFormula And _
Not .Cells(i2, "A").MergeCells Then
Exit For
End If

Next i2

meuIntervalo2 = .Range("I" & i2).Address
.PageSetup.PrintArea = "$B$1:" & meuIntervalo2
.PrintOut

End With
End With

With ThisWorkbook
.Activate
With .Worksheets("ECTE")

.Activate

ActiveSheet.PrintOut
End With
End With

With ThisWorkbook
.Activate
With .Worksheets("LISTAGEM")

.Activate
End With

End With

End If

End Sub

E ali no meio precisava adicionar essa nova função, já tentei definindo variável para o range, usando if e else, já tentei com Do While e com For e Next, mas não consegui fazer funcionar.

Alguém consegue me ajudar? :) Muito obrigado.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


andril
Acabou de chegar
Acabou de chegar
Mensagens: 9
Registrado em: Sáb Dez 28, 2019 5:23 am

Re: Imprimir página se encontra palavra específica

Mensagem por andril »

Opa!!!

Consegui fazer, usei o código abaixo no meio do outro acima:

With ThisWorkbook
.Activate
With .Worksheets("LISTAGEM") 'Ativa a planilha onde é feita a busca;

.Activate
LR3 = .Cells(.Rows.Count, 4).End(xlUp).Row 'Faz a busca na coluna D;

For i3 = 8 To LR3 'Começando a partir da linha 8, já que na linha 7 já tinha a mesma palavra como referência;

If Cells(i3, 4).Value = "CUBAR" Then

Worksheets("ROMCUB").Activate 'Ativa a planilha que será impressa;

ActiveSheet.PrintOut 'Imprime

End If
Next
End With
End With

Ficou assim completo e otimizado:

Sub imprimeintervalocomdados()

Dim meuIntervalo As String
Dim LR As Long
Dim i As Long
Dim meuIntervalo2 As String
Dim LR2 As Long
Dim i2 As Long
Dim meuIntervalo3 As String
Dim LR3 As Long
Dim i3 As Long

If MsgBox("IMPRIMIR?", vbYesNo) = vbYes Then

If Worksheets("LISTAGEM").Range("C4").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

If Worksheets("LISTAGEM").Range("C5").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

If Worksheets("LISTAGEM").Range("C6").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

If Worksheets("LISTAGEM").Range("E5").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

If Worksheets("LISTAGEM").Range("E6").Value = "" Then

MsgBox "INFORMAÇÕES INCOMPLETAS!"

Exit Sub

End If

With ThisWorkbook
.Activate
With .Worksheets("IMPRESSAO")

.Activate
LR = .Cells(.Rows.Count, 1).End(xlUp).Row

For i = 1 To LR

If .Cells(i, "A").Value = "" And _
.Cells(i, "A").HasFormula And _
Not .Cells(i, "A").MergeCells Then
Exit For
End If

Next i

meuIntervalo = .Range("C" & i).Address
.PageSetup.PrintArea = "$A$1:" & meuIntervalo
.PrintOut

End With
End With

With ThisWorkbook
.Activate
With .Worksheets("LISTAGEM")

.Activate
LR3 = .Cells(.Rows.Count, 4).End(xlUp).Row

For i3 = 8 To LR3

If Cells(i3, 4).Value = "CUBAR" Then

Worksheets("ROMCUB").Activate

ActiveSheet.PrintOut

End If
Next
End With
End With

With ThisWorkbook
.Activate
With .Worksheets("ROMANEIO")

.Activate
LR2 = .Cells(.Rows.Count, 1).End(xlUp).Row

For i2 = 1 To LR2

If .Cells(i2, "A").Value = "" And _
.Cells(i2, "A").HasFormula And _
Not .Cells(i2, "A").MergeCells Then
Exit For
End If

Next i2

meuIntervalo2 = .Range("I" & i2).Address
.PageSetup.PrintArea = "$B$1:" & meuIntervalo2
.PrintOut

End With
End With

With ThisWorkbook
.Activate
With .Worksheets("ECTE")

.Activate

ActiveSheet.PrintOut
End With
End With

With ThisWorkbook
.Activate
With .Worksheets("LISTAGEM")

.Activate
End With

End With

End If

End Sub

Até a próxima! Quando apertar corro pra cá de novo!


Responder