Jump to content
Fórum Script Brasil
  • 0

Inserção de Imagens Via VBA


Question

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


 

Edited by Vini Goulart
Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Cloud Computing


  • Forum Statistics

    • Total Topics
      149403
    • Total Posts
      645891
×
×
  • Create New...