Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Copiar,colar e impr...
 
Notifications
Clear all

Copiar,colar e imprimir

 
2024 - VBA & Macros
Post Recente por MPrudencio 9 anos atrás
6 Posts
2 Usuários
0 Reactions
1,564 Visualizações
RSS
 frolim
(@frolim)
Posts: 8
Active Member
Topic starter
 

Boa tarde,

Tenho um problema que é o seguinte:

Tenho que coletar um dado através de leitor óptico no Excel,após coletado esse dado é confrontado com uma base, caso conste esse dado coletado na base(verificação através de PROCV)é necessário que se imprima uma etiqueta com essa informação coletada, senão é pra seguir a coleta, porém eu preciso criar uma base de dados com essas informações coletadas.
Para isso estou usando dois códigos, mas precisava que os dois funcionassem de forma automática conforme fosse coletando a informação.

Alguém consegue me ajudar:

Código para impressão:

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("D9") = "Ok" Then

Range("B3:D4").Select
ActiveWindow.SelectedSheets.PrintOut

Range("B3:D4").Select

End If

End Sub

Código para copiar:

Sub CopiaColaValores()

Dim UltimaLinha As Long
Dim RngACopiar As Range

Set RngACopiar = Worksheets("cross").Range("B3:D4")

RngACopiar.Copy

UltimaLinha = Worksheets("Plan1").Cells(Rows.Count, 1).End(xlUp).Row

If UltimaLinha < 2 Then
UltimaLinha = 2
Worksheets("Plan1").Range("A" & UltimaLinha).PasteSpecial Paste:=xlPasteValues

Else

UltimaLinha = UltimaLinha + 1
Worksheets("Plan1").Range("A" & UltimaLinha).PasteSpecial Paste:=xlPasteValues

End If

Application.CutCopyMode = False

Range("B3:D4").Select

End Sub

 
Postado : 02/02/2016 1:21 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Se o codigo de Copiar estiver funcionando corretamente pode ser feito assim:

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("D9") = "Ok" Then

Call CopiaColaValores

Range("B3:D4").Select

ActiveWindow.SelectedSheets.PrintOut

Range("B3:D4").Select

End If

End Sub

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 02/02/2016 1:35 pm
 frolim
(@frolim)
Posts: 8
Active Member
Topic starter
 

Tentei o código abaixo, mas não funcionou:

Para impressão:

Private Sub Worksheet_Change(ByVal Target As Range)

If Worksheets("cross").Range("D9") = "Ok" Then

Call CopiaColaValores

Range("B3:D4").Select

ActiveWindow.SelectedSheets.PrintOut

Worksheets("cross").Range("B3:D4").Select

ElseIf Worksheets("cross").Range("D9") = "Ok" Then

Call CopiaColaValores

Worksheets("cross").Range("B3:D4").Select

End If

End Sub

Para copiar:

Sub CopiaColaValores()

Worksheets("cross").Range("B3:D4").Select

Dim UltimaLinha As Long
Dim RngACopiar As Range

Set RngACopiar = Worksheets("cross").Range("B3:D4")

RngACopiar.Copy

UltimaLinha = Worksheets("Plan1").Cells(Rows.Count, 1).End(xlUp).Row

If UltimaLinha < 1 Then
UltimaLinha = 1
Worksheets("Plan1").Range("A" & UltimaLinha).PasteSpecial Paste:=xlPasteValues

Else

UltimaLinha = UltimaLinha + 1
Worksheets("Plan1").Range("A" & UltimaLinha).PasteSpecial Paste:=xlPasteValues

End If

Application.CutCopyMode = False

Worksheets("cross").Range("B3:D4").Select

End Sub

Acredito que o código de cópia ta bugado...

 
Postado : 02/02/2016 2:13 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Ve se isso ajuda

Da uma olhada na celula B9 da planilha Cross

Devo ter apagado algo...

TESTE OBJETO.zip

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 02/02/2016 2:51 pm
 frolim
(@frolim)
Posts: 8
Active Member
Topic starter
 

Marcelo,

Muuuito obrigado cara, consegui o que precisava, só adaptei o com o ElseIf pois precisava que gravasse mesmo que não estivesse com o Ok.

Private Sub Worksheet_Change(ByVal Target As Range)

If Worksheets("cross").Range("D9") = "Ok" Then

Call Copiar

Range("B3:D4").Select

ActiveWindow.SelectedSheets.PrintOut

ElseIf Worksheets("cross").Range("D9") = "" Then
Call Copiar

Worksheets("cross").Range("B3:D4").Select

End If

End Sub

Valeu mesmo.

Abs

 
Postado : 03/02/2016 9:02 am
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Era so trocar o Call Copiar de lugar....

Colocando antes do if assim

Call Copiar

If Worksheets("cross").Range("D9") = "Ok" Then

continua a macro

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 03/02/2016 9:08 am
Forum Jump:
  Tópico Anterior
Próximo Tópico