- 09 Fev 2016 às 22:58
#7462
Minha pasta de trabalho tem 4 planilhas cujo intervalo de impressão são equivalentes. Para cada uma existe uma macro que efetua uma verificação antes de imprimir. Ela esta ai abaixo para que saiba como está. Meu desejo é reduzir de 4 macros para apenas uma que possa ser executada nas 4 planilhas em questão. Ou seja: desejo que esta macro rode na planilha ativa. Como posso fazer isso?
Sub Verif_e_ImprimeLoja()
' Macro sendo usada para verificar as condições
Dim Msg As Boolean
Dim rng As Range, c As Range
Dim LR As Long
With ActiveSheet
LR = .Cells(Rows.Count, 2).End(xlUp).Row 'define a última linha não vazia
LR = IIf(LR < 7, 7, LR)
Set rng = Range("B7:B" & LR)
Set c = rng.Find("*")
Msg = IIf(Not c Is Nothing, True, False)
Select Case Msg
Case True
Call Print_CX_LOJA ' ** Chama sua Rotina que imprime
Case False
MsgBox "Não há dados a serem impressos", 64, "Atenção"
End Select
End With
End Sub
Private Sub Print_CX_LOJA()
'Macro sendo usada para imprimir
'caminho = Sheets("DadosGerais").Range("F5").Value
caminho = ActiveSheet.Range("E1").Value 'O local onde será salvo
Nome = ActiveSheet.Range("b3").Value ' O nome que o aqrquivo receberá
'Intervalo para impressão inicia em B3, mas só deve ser impresso se alguma célula da coluna B estiver preenchida
Dim LR As Long
With ActiveSheet
LR = .Cells(Rows.Count, 2).End(xlUp).Row 'define a ultima linha nao vazia
LR = IIf(LR < 3, 3, LR) ' se Lr é menor que 3 define Lr com 3
.Range("B3:F" & LR).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
caminho & Nome
Selection.PrintOut From:=1, To:=1, Copies:=1
.Range("A7").Select
End With
End Sub
Sub Verif_e_ImprimeLoja()
' Macro sendo usada para verificar as condições
Dim Msg As Boolean
Dim rng As Range, c As Range
Dim LR As Long
With ActiveSheet
LR = .Cells(Rows.Count, 2).End(xlUp).Row 'define a última linha não vazia
LR = IIf(LR < 7, 7, LR)
Set rng = Range("B7:B" & LR)
Set c = rng.Find("*")
Msg = IIf(Not c Is Nothing, True, False)
Select Case Msg
Case True
Call Print_CX_LOJA ' ** Chama sua Rotina que imprime
Case False
MsgBox "Não há dados a serem impressos", 64, "Atenção"
End Select
End With
End Sub
Private Sub Print_CX_LOJA()
'Macro sendo usada para imprimir
'caminho = Sheets("DadosGerais").Range("F5").Value
caminho = ActiveSheet.Range("E1").Value 'O local onde será salvo
Nome = ActiveSheet.Range("b3").Value ' O nome que o aqrquivo receberá
'Intervalo para impressão inicia em B3, mas só deve ser impresso se alguma célula da coluna B estiver preenchida
Dim LR As Long
With ActiveSheet
LR = .Cells(Rows.Count, 2).End(xlUp).Row 'define a ultima linha nao vazia
LR = IIf(LR < 3, 3, LR) ' se Lr é menor que 3 define Lr com 3
.Range("B3:F" & LR).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
caminho & Nome
Selection.PrintOut From:=1, To:=1, Copies:=1
.Range("A7").Select
End With
End Sub