- 23 Jan 2023 às 10:20
#72767
Bom dia, Pessoal
Sou novato aqui e tambem na linguagem VBA.
Tenho o código abaixo que foi copiado de algum lugar da internet, estou adaptando mas sem sucesso.
Essa macro faz um loop de 4 vezes e deve pular para o proxima linha e refazer o loop ate terminar de colar as imagens, mas o mesmo so faz uma vez e termina.
Tem duas pastas uma com os codigos dos produtos e outra onde eu monto o catalogo de produtos
Public UL As Integer
Sub seq()
Dim caminho As String
Dim LOCAL1 As String
Dim lin As Integer
lin = 2
' (CATALOGO) aPAGAR AS IMAGENS PARA NOVA COLAGEM
Range("B4").Select
Planilha1.DrawingObjects.delete
'----------------------------------------------------------------
' (Lista) ver o numero de linhas
Do
Planilha5.DrawingObjects.Select
UL = Sheets("LISTA").Cells(Cells.Rows.Count, 2).End(xlUp).Row
'-----------------------------------------------------------------
' (Lista) posicionar na primeira linha
'Do While UL <> 0
'UL = UL - 1
With Planilha5
For lin = lin To 5
caminho = ThisWorkbook.Path & "\" & .Range("a" & lin) & ".jpg"
Set ShpImagem = .Shapes("moldura")
With ShpImagem
.Fill.UserPicture picturefile:=caminho
End With
.Range("F1").Copy
Planilha1.Activate
Planilha1.Pictures.Paste
ActiveCell.Offset(0, 3).Select
lin = lin
Next
End With
ActiveCell.Offset(3, -12).Select
Loop
End Sub
Sou novato aqui e tambem na linguagem VBA.
Tenho o código abaixo que foi copiado de algum lugar da internet, estou adaptando mas sem sucesso.
Essa macro faz um loop de 4 vezes e deve pular para o proxima linha e refazer o loop ate terminar de colar as imagens, mas o mesmo so faz uma vez e termina.
Tem duas pastas uma com os codigos dos produtos e outra onde eu monto o catalogo de produtos
Public UL As Integer
Sub seq()
Dim caminho As String
Dim LOCAL1 As String
Dim lin As Integer
lin = 2
' (CATALOGO) aPAGAR AS IMAGENS PARA NOVA COLAGEM
Range("B4").Select
Planilha1.DrawingObjects.delete
'----------------------------------------------------------------
' (Lista) ver o numero de linhas
Do
Planilha5.DrawingObjects.Select
UL = Sheets("LISTA").Cells(Cells.Rows.Count, 2).End(xlUp).Row
'-----------------------------------------------------------------
' (Lista) posicionar na primeira linha
'Do While UL <> 0
'UL = UL - 1
With Planilha5
For lin = lin To 5
caminho = ThisWorkbook.Path & "\" & .Range("a" & lin) & ".jpg"
Set ShpImagem = .Shapes("moldura")
With ShpImagem
.Fill.UserPicture picturefile:=caminho
End With
.Range("F1").Copy
Planilha1.Activate
Planilha1.Pictures.Paste
ActiveCell.Offset(0, 3).Select
lin = lin
Next
End With
ActiveCell.Offset(3, -12).Select
Loop
End Sub