Inserção de Imagens Via VBA

[Vini Goulart]

Olá gente, tudo bem?

Estava tentando criar uma macro que adicionasse imagens em posições especificas, com 6 imagens em cada aba/guia do excel.
Já consegui criar uma outra macro, que resolve parcialmente meu problema, e que a partir de um botão, insere as imagens, porém 6 de cada vez.
Agora, queria fazer ela adicionar todas as imagens de uma vez, mas não consigo, porque ele sempre insere todas na mesma aba/guia.

o que eu preciso, é que ele faça o seguinte:

• abra a janela de selecionar fotos (já faz isso)
• veja a quantidade de fotos:
• Se for até 6 fotos, coloca todas na primeira aba
• Se for maior que 6, primeiro insere 6, depois cria outra aba, e insere outras 6.
• Se ainda houver outras fotos, ele novamente cria outra aba, e reinsere as imagens.

Já consigo fazer os passos de forma separada, mas não sei como diferenciar os casos dentro do VBA, pra ele entender o que eu quero.
Consegui fazer ele criar outra aba, inserir as fotos, e também dá pra alterar as dimensões.
Não sei como fazer o VBA entender oque preciso, vocês conseguem me ajudar?
Abaixo tem a programação escrita, caso ajude.
Link da planilha de base

Envio anexa a planilha de base, com oque estou tentando fazer.
 

Private Sub CommandButton1_Click()
'
'----------------------------------------DEFINIÇÃO DE VARIÁVEIS-------------------------
    j = 1
    Celula = "B7"        ' celula que será inserido a imagem
    lim = 6              ' limite de imagens por página
    altura = 6.85        ' altura das imagens
    largura = 8.06       ' largura das imagens
    constante = 28.34    ' constante para converter de pixels
    Celula1 = "B7"       ' célula em que será inserida cada imagem
    Celula2 = "G7"       ' célula em que será inserida cada imagem
    Celula3 = "B21"      ' célula em que será inserida cada imagem
    Celula4 = "G21"      ' célula em que será inserida cada imagem
    Celula5 = "B35"      ' célula em que será inserida cada imagem
    Celula6 = "G35"      ' célula em que será inserida cada imagem
'----------------------------------------FIM DE DEFINIÇÃO DE VARIÁVEIS-------------------------
    Dim Pict
    Dim ImgFileFormat As String
    ImgFileFormat = "Image Files JPEG (*.jpeg),*.jpeg,Image Files JPG (*.jpg),*.jpg, Image Files PNG (*.png),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
    
    'Pict = Application.GetOpenFilename(ImgFileFormat, False, False, MultiSelect:=True)
    
    Pict = Application.GetOpenFilename(, False, False, False, True)
    
    'If Pict = False Then End
'--------->se o índice da última imagem for maior que "lim", ele insere imagens e depois cria outra aba

        If UBound(Pict) <= lim Then  'Executa se a quantidade de imagens for igual ou menor que "lim"
                    

            For i = LBound(Pict) To UBound(Pict) 'FOR I

             x = i Mod 6                 'índice da imagem, de 1 a 6, calculado a partir_
                                         'do resto da divisão do índice por 6.
                Select Case x 'Cobertura de 6 imagens
                   
                    Case 1
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula1).Left, _
                        Range(Celula1).Top, largura * constante, altura * constante

                    Case 2
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula2).Left, _
                        Range(Celula2).Top, largura * constante, altura * constante
                    
                    Case 3
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula3).Left, _
                        Range(Celula3).Top, largura * constante, altura * constante
                        
                    Case 4
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula4).Left, _
                        Range(Celula4).Top, largura * constante, altura * constante
                    
                    Case 5
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula5).Left, _
                        Range(Celula5).Top, largura * constante, altura * constante
                        
                    Case 0
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula6).Left, _
                        Range(Celula6).Top, largura * constante, altura * constante
    End Select
        
                Next i 'FOR I
        
    Else                                                    'Executa se a quantidade de imagens for maior que "lim"
   '------------------------Criar Nova Aba--------------------------
    n = ActiveSheet.Index                                   'insere nova aba em branco
    Sheets("F-MODELO").Visible = True                       '
    Sheets("F-MODELO").Copy After:=ActiveSheet              '
    ActiveSheet.Name = "For 8.3.8 (" & n + 1 & ")"          '
    Sheets("F-MODELO").Visible = False
    '----------------------Ir para nova aba------------------------
    Sheets(n + 1).Select                                    'altera para próxima aba
    For i = LBound(Pict) To UBound(Pict) 'FOR I

             x = i Mod 6                 'índice da imagem, de 1 a 6, calculado a partir_
                                         'do resto da divisão do índice por 6.
                Select Case x 'Cobertura de 6 imagens
                   
                    Case 1
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula1).Left, _
                        Range(Celula1).Top, largura * constante, altura * constante

                    Case 2
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula2).Left, _
                        Range(Celula2).Top, largura * constante, altura * constante
                    
                    Case 3
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula3).Left, _
                        Range(Celula3).Top, largura * constante, altura * constante
                        
                    Case 4
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula4).Left, _
                        Range(Celula4).Top, largura * constante, altura * constante
                    
                    Case 5
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula5).Left, _
                        Range(Celula5).Top, largura * constante, altura * constante
                        
                    Case 0
                        Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula6).Left, _
                        Range(Celula6).Top, largura * constante, altura * constante
    End Select
        
                Next i 'FOR I
   
          
        End If 'IF I

End Sub

 

Editado Maio 20, 2021 por Vini Goulart