Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por luizmaglia
#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
Por osvaldomp
#72768
Olá, Luiz.

Sugestão: anexe diretamente aqui no fórum uma amostra do seu arquivo Excel com as imagens e com o código instalado.

Deixe de lado um momento o seu código e descreva com exatidão na própria planilha o que você deseja fazer via macro.

obs. para facilitar a leitura, ao postar códigos VBA, selecione o código colado e aperte o ícone </> no cabeçalho da sua mensagem.
Por luizmaglia
#72769
Gerar_Lista_Novo.xlsm
Ola Osvaldo,

Essa macro seria para um catalogo de produtos.
Copia conforme relaçao dos codigos da planilha lista e cola na planilha catalogo, ou seja faz 4 quatro vez a colagem e depois desce algumas linhas começa a colar mais 4 vezes e assim até terminar conforme a planilha lista

Obrigado,
Você não está autorizado a ver ou baixar esse anexo.
Por osvaldomp
#72770
Olá, Luiz.

Veja se este código lhe atende.
Código: Selecionar todos
Sub seqV2()
 Dim UL As Long, lin As Long, k As Long, i As Long, caminho As String, ShpImagem As Shape
  Application.ScreenUpdating = False
  Planilha1.DrawingObjects.delete
  With Sheets("LISTA")
   UL = .Cells(Rows.Rows.Count, 2).End(xlUp).Row
   Set ShpImagem = .Shapes("moldura")
   For lin = 2 To UL
    caminho = ThisWorkbook.Path & "\" & .Range("A" & lin) & ".jpg"
    ShpImagem.Fill.UserPicture picturefile:=caminho
    .Range("F1").Copy
     Planilha1.Paste Cells(k + 4, i + 2)
     i = i + 3: If i > 11 Then k = k + 3: i = 0
   Next lin
  End With
End Sub
Por luizmaglia
#72772
Boa tarde, Osvaldo
O codigo resolveu minha duvida

Tenho outra duvida que e referente ao codigo abaixo que seria redimensionar somente uma imagem do arquivo no caso a que estiver selecionada e nao todas
Código: Selecionar todos
Sub AjustaTamanho()
     For Each sh In ActiveSheet.Shapes
        If sh.Name Like "*Pict*" Then
        ActiveSheet.Shapes.Range(Array(sh.Name)).Select
          With Selection
            .Top = sh.TopLeftCell.Top
            .Left = sh.TopLeftCell.Left
            .ShapeRange.Height = 130
            .ShapeRange.Width = 130
          End With
        End If
    Next
End Sub
obrigado
Por osvaldomp
#72773
luizmaglia escreveu: 25 Jan 2023 às 12:39 ... redimensionar somente uma imagem ... que estiver selecionada ...
Código: Selecionar todos
Sub AjustaTamanho()
          With Selection
            .Top = sh.TopLeftCell.Top
            .Left = sh.TopLeftCell.Left
            .ShapeRange.Height = 130
            .ShapeRange.Width = 130
          End With
End Sub
Mantive no seu código somente as linhas de interesse.
Selecione manualmente a imagem e rode o código. Veja se atende.
Por luizmaglia
#72774
Boa tarde,

Nao rodou veja o erro
Erro em tempo de execucao 424

O objeto e obrigatorio
Por osvaldomp
#72776
Desculpe, falha minha.

Remova também as duas ocorrências de sh #(mantenha o ponto que está à direita).

=SE(MÊS(A1)&lt;7;&quot;1º sem&a[…]

Bom Dia Senhores. Tenho uma macro que preciso dei[…]

Free relationships without drama and obligations. […]

Girar Imagem e Zoom

Boa noite Teria alguma forma de dar um &quot;[…]

Valeu. Muito Obrigado!!!!!!!!

Pessoal, Ao clicar no botão Copiar (Guia C[…]

Procv com serro em vba

Resolvido

Bom dia, pessoal! com a data de nascimento e data […]

Estamos migrando para uma comunidade no Discord