Este fórum está sendo desativado

[rit]

Boa tarde amigos,

eu tenho uma planilha que eu faço etiquetas eu queria um código que faz impressão e defina a quantidade a partir de uma celula as configurações de impressão eu vou deixar gravada então isso nao importa, a primeira planilha eu quero que ele coloque a quanttidade que esta na celula E4, a segunda planilha vai ser sempre 1 impressão, alguem pode fazer esse código para mim ?

Obrigado.

[gfranco]

Boa noite.
Veja se ajuda:

Código: Selecionar todos

Sub imprimir()
On Error GoTo erro_imprime
Dim numeroCópias As Long
If Not VBA.IsNumeric(Plan1.Range("e4")) Or Plan1.Range("e4") < 1 Then
MsgBox "Informe a quantidade de impressões"
Exit Sub


End If

numeroCópias = Plan1.Range("e4").Value

Plan1.PrintOut copies:=numeroCópias
Plan2.PrintOut copies:=1
Exit Sub

erro_imprime:

MsgBox "Um erro ocorreu, verifique"

End Sub

[rit]

Obrigado Gfranco isso resolveu 100% o que eu preciso para um arquivo só.


Eu adicionei esse código a um botão no excel, e gostaria de saber se tem como eu fazer uma macro para apertar varios desses botões em arquivos diferentes (nomes diferentes)
Exemplo: Eu tenho esse arquivo ai que é o numero 1 ai vai ter uma quantidade X de arquivos uns 15 por dia, e eu queria criar um arquivo "mestre"
que faça o seguinte, eu alimente ele com o nome dos arquivos, aperte um Botão e ele procure no diretorio executando o processo de impressão, que seria apertar o botão
de cada arquivo.

não sei se é trabalhoso fazer isso, andei pesquisando e tem alguns códigos parecidos na internet mas sempre para um arquivo só, e o que eu quero é que o código faça
a abertura e execução das macros de impressão a partir de uma "lista de nomes" que eu vou alimentar.

[gfranco]

Os arquivos alvo são idênticos a esse modelo que vc postou acima?
Eles estarão numa mesma pasta?

[rit]

Sim, são identicos e estarão na mesma pasta.

[gfranco]

Boa tarde.
Salve essa sub numa pasta em branco.
ela comandará a impressão conforme vc descreveu que necessita.
Deixei umas instruções para vc se localizar.
Obs: NÃO TESTADA !

Dê retorno.

Código: Selecionar todos

Sub imprimir()
On Error GoTo erro_imprime
Dim numeroCópias As Long
Dim arq() As Variant
Dim wbprincipal As Workbook, wbaberto As Workbook
Dim contaErros As Long
Dim nomeArquivo As String
Set wbprincipal = ThisWorkbook
contaErros = 0
'linha abaixo pede para navegar até a pasta e selecionar os arquivos para impressão
arq = Application.GetOpenFilename("Arquivos do Excel (*.xls*),*.xls*", Title:="Selecione os arquivos", MultiSelect:=True)

Application.ScreenUpdating = False

'inicio do loop pelos arquivos apontados....

For A = LBound(arq()) To UBound(arq())

nomeArquivo = arq(A)

Application.Workbooks.Open nomeArquivo

Set wbaberto = ActiveWorkbook

'abaixo: se a célula "E4" do arquivo contiver um número, então manda para impressão
If VBA.IsNumeric(wbaberto.Worksheets(1).Range("e4").Value) And wbaberto.Worksheets(1).Range("e4").Value > 0 Then

numeroCópias = wbaberto.Worksheets(1).Range("e4").Value

wbaberto.Worksheets(1).PrintOut copies:=numeroCópias
wbaberto.Worksheets(2).PrintOut copies:=1

'se a célula não contiver um número, o nome do arquivo será printado na janela de verificação imediata (Control + G) para vc avaliar
Else

Debug.Print nomeArquivo
contaErros = contaErros + 1


End If

Application.DisplayAlerts = False
wbaberto.Close savechanges:=False
Application.DisplayAlerts = True

Next A


Application.ScreenUpdating = True

wbprincipal.Activate


If contaErros = 0 Then


MsgBox "Processo concluido, Todos os arquivos foram impressos"


Else

MsgBox "Processo concluido" & VBA.Chr(13) & "Porém, alguns arquivos apresentaram problemas" & VBA.Chr(13) & "Verifique a janela de Verificação,Teclando Control + g"


End If



Exit Sub

erro_imprime:
Application.ScreenUpdating = True
MsgBox "Um erro ocorreu, verifique"

End Sub

[rit]

gfranco bom dia,

Aparentemente esta dando certo mas ainda nao consegui testar na impressora de etiqueta, ela quebrou semana passada e vao arrumar hoje, assim que eu conseguir fazer um teste te dou um feedback por aqui.

obrigado!

[gfranco]

Ok. Fico no aguardo do retorno.
Caso encontre algum problema procure detalhar para que eu faça a correção.
At.
Giovani.

[rit]

Cara perfeito, testei em algumas etiquetas e até então nenhum problema, ganhei até um parabens de quem vai fazer esse serviço de impressão, o cara que fazia isso abria um por um.. Muito obrigado!