Guru do Excel e Power BI

Public Caminho As String
Public Quantidade As Long
Public fso As Object 'Scripting.FileSystemObject
Public fsoFolder As Object 'Scripting.Folder

Sub SelecionarPasta()
    
    With Application.FileDialog(msoFileDialogFolderPicker)

    .Show
        
        If .SelectedItems.Count > 0 Then
        Caminho = .SelectedItems(1)
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fsoFolder = fso.GetFolder(Caminho) 'csDirectory
        Quantidade = fsoFolder.Files.Count
        
        End If

        'MsgBox "O diretório " & Caminho & " possui " & fsoFolder.Files.Count & " imagens.", vbInformation
        
    End With

    Worksheets("Fotos").Range("F1").Value = Caminho + "\"
    Worksheets("Fotos").Range("G1").Value = Quantidade
    
    ImportarFotos
    
    'MsgBox "Pasta selecionada! " & Caminho, vbInformation, "PASTA"
    
End Sub

Sub ImportarFotos()

Dim NomeDoArquivo As String
Dim Imagem As Picture
Dim rngCell As Range
Dim i As Integer
Dim e As Integer

Caminho = Worksheets("Fotos").Range("F1").Value
Quantidade = Worksheets("Fotos").Range("G1").Value

    Set rngCell = Range("B2")    'A primeira imagem "setada" na celula B2 não está redimensionando.
            
    NomeDoArquivo = Dir(Caminho & "*.jpg", vbNormal)    'Ao fazer o Loop ele não esta buscando a próxima imagem da pasta.
    
    Do While Len(Quantidade) > 0    'Limitar a 8 imagens ou ao valor da variavel Quantidade, o que for menor.
    
        If (i <= Quantidade) Then
        
         Set Imagem = Worksheets("Fotos").Pictures.Insert(Caminho & NomeDoArquivo)
           With Imagem
                .Left = rngCell.Left
                .Top = rngCell.Top          'As imagens não estão sendo redimensionadas.
                .Height = rngCell.Height
                .Placement = xlMoveAndSize
             End With
            
            Set rngCell = rngCell.Offset(3, 0)    'a ordem de preenchimento deve ser por linha. Sequencia B2 > D2 > B5 > D5 > B8 > D8 > B11 > D11.
            i = i + 1
        Else
            Set rngCell = rngCell.Offset(1, 0)
            i = 0
        End If
        
    Loop    'Entrando em Loop Infinito. Antes de executar, marcar ponto de interrupção.
    
    MsgBox "Imagens copiadas com sucesso!", vbInformation, "IMPORTAÇÃO"
    
End Sub

Sub ImportarFotos()

Dim NomeDoArquivo As String
Dim Imagem As Picture
Dim rngCell As Range

Caminho = Worksheets("Fotos").Range("F1").Value
'Quantidade = Worksheets("Fotos").Range("G1").Value

'    Set rngCell = Range("B2") 'A primeira imagem "setada" na celula B2 não está redimensionando.
            
    NomeDoArquivo = Dir(Caminho & "*.png", vbNormal) 'Ao fazer o Loop ele não esta buscando a próxima imagem da pasta.
'    Do While Len(Quantidade) > 0 'Limitar a 8 imagens ou ao valor da variavel Quantidade, o que for menor.
    
    'curso de excel gratis, faz o looping enquanto encontra arquivo
    Dim cont As Integer
    
    Dim linha As Integer
    Dim coluna As Integer
    
    linha = 2
    coluna = 2
    cont = 1
    Do While NomeDoArquivo <> ""
    
        Set rngCell = Cells(linha, coluna)
        
       
         Set Imagem = Worksheets("Fotos").Pictures.Insert(Caminho & NomeDoArquivo)
         With Imagem
                .Left = rngCell.Left
                .Top = rngCell.Top          'As imagens não estão sendo redimensionadas.
                .Height = rngCell.Height
                .Width = rngCell.Width  'curso de excel gratis,
                'inclui isto aqui, mas na realidade teria que ter um esquema de saber se tem que ajustar a altura ou a largura
                'pode ser algo simples assim :
                If .Height > rngCell.Height Then
                    .Height = rngCell.Height
                End If
                .Placement = xlMoveAndSize
        End With
        'verifica a proxima linha
        cont = cont + 1
        If cont Mod 2 = 0 Then
            'a proxima vai ser na mesma linha porem na coluna D
            coluna = 4
        Else
            'volta para a primeira coluna e soma a linha
            coluna = 2
            linha = linha + 3
        End If
    
        'curso de excel gratis
        NomeDoArquivo = Dir() 'pega o proximo arquivo
        
    Loop 'Entrando em Loop Infinito. Antes de executar, marcar ponto de interrupção.
    
    MsgBox "Imagens copiadas com sucesso!", vbInformation, "IMPORTAÇÃO"
    
End Sub