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,558 Visualizações
RSS
 frolim
(@frolim)
Posts: 0
New 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: 0
New 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

 
Postado : 02/02/2016 1:35 pm
 frolim
(@frolim)
Posts: 0
New 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: 0
New Member
 

Ve se isso ajuda

Da uma olhada na celula B9 da planilha Cross

Devo ter apagado algo...

TESTE OBJETO.zip
 
Postado : 02/02/2016 2:51 pm
 frolim
(@frolim)
Posts: 0
New 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: 0
New 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

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