0

Bom, procurei uma solução para meu problema, (por muitas fotos de uma só vez e de forma organizada na planilha) no Youtube, fóruns e etc., mas a solução mais próxima foi essa a baixo, que originalmente preenchia por coluna, tentei editar o código para que pudesse executar da forma que eu preciso, mas ele simplesmente empilha tudo no canto direito da planilha.

 Private Sub Inseri_Click()
 Dim strFolder As String
 Dim strFileName As String
 Dim objPic As Picture
 Dim rngCell As Range
 
 Dim i As Integer
 
 
  strFolder = ThisWorkbook.Path & "\" 'diz o caminho das imagens
   If Right(strFolder, 1) <> "\" Then 'verificando se esta vazio
   strFolder = strFolder & "\"
   End If
   
   Set rngCell = Range("F2")
   
   strFileName = Dir(strFolder & "*.jpg", vbNormal)
    Do While Len(strFileName) > 0
    Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName)
With objPic
.Left = rngCell.Left
.Top = rngCell.Top
.Height = rngCell.Height
.Placement = xlMoveAndSize
End With

If (i < 5) Then
Dim e As Integer
e = e + 1
Set rngCell = rngCell.Offset(0, e)
i = i + 1
Else
Set rngCell = rngCell.Offset(1, 0)
i = 0
End If
strFileName = Dir




 Loop
End Sub

1 Resposta 1

0

O problema é o seguinte:

.Left = rngCell.Left
.Top = rngCell.Top

Todas as vezes que passa por ai coloca o valor Set rngCell = Range("F2"). Precisa de colocar uma variável e incrementar esse valor com um loop.

Exemplo:

 For i = 1 To 6 Step 1
      ActiveSheet.Pictures.Insert(caminho).Select
            With Selection
                .Left = Cells(i, 1).Left
                .Top = Cells(i, 1).Top
                .ShapeRange.LockAspectRatio = msoFalse
                If .ShapeRange.Height > Cells(i, 1).RowHeight Then
                    .ShapeRange.Height = Cells(i, 1).RowHeight
                End If
                If .ShapeRange.Width > range("A2").Width Then
                    .ShapeRange.Width = range("A2").Width
                End If
                .ShapeRange.Rotation = 0#
                
                .Left = (range("A2", "D2").Width - .ShapeRange.Width) / 2
                .Top = Cells(i, 1).Top + (Cells(i, 1).RowHeight - .ShapeRange.Height) / 2
            End With
   next

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .