none
IMPORTAR IMAGENS E FORMATAR TAMANHO RRS feed

  • Pergunta

  • Boa Tarde Amogos Internautas

    Gostaria de saber se alguem sabe como importa uma imagem para uma planilha através de uma macro no tamanho unico determindo tambem por uma macro.

    SDS

    Mauro

    terça-feira, 26 de abril de 2011 17:29

Respostas

  • Olá Mauro boa noite,

    Temos 2 soluções:

    Solução 1:

    Segue a solução do seu problema: (Nesta solução você não consegue alterar o tamanho da imagem, mas acho interessante você entender e poder utilizar também)

    - Insira um botão em sua planilha

    - Clique com o botão direito em seu botão e clique em Atribuir macro

    - Será solicitado o nome da macro: coloque Pasta1!Inserir_clique e clique em Novo

    - Será exibido seu Módulo1 que será exibido o seguinte:

    Sub Inserir_clique()

    End Sub

    Adicione a seguinte linha:

    Sub Inserir_clique()
    'Chamada da procedure de importação da imagem
    ImportPicture
    End Sub

    Em seguida crie a seguinte procedure:

    Sub ImportPicture()
    'Caminho da sua imagem e localização na planilha, neste caso célula D10 centralizado na vertical e horizontal
        InsertPicture "C:\Users\Carlos Citrangulo\Pictures\partner_network.jpg", Range("D10"), True, True
    End Sub

    Em seguida crie mais esta procedure:

    Sub InsertPicture(PictureFileName As String, TargetCell As Range, CenterH As Boolean, CenterV As Boolean)
    ' insere uma imagem na posição do canto superior esquerdo do TargetCell
    ' a imagem pode ser centralizada horizontalmente e/ou verticalmente
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
        If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
        If Dir(PictureFileName) = "" Then Exit Sub
        ' importa imagem
        Set p = ActiveSheet.Pictures.Insert(PictureFileName)
        ' determina as posições
        With TargetCell
            t = .Top
            l = .Left
            If CenterH Then
                w = .Offset(0, 1).Left - .Left
                l = l + w / 2 - p.Width / 2
                If l < 1 Then l = 1
            End If
            If CenterV Then
                h = .Offset(1, 0).Top - .Top
                t = t + h / 2 - p.Height / 2
                If t < 1 Then t = 1
            End If
        End With
        'posição da imagem
        With p
            .Top = t
            .Left = l
        End With
        Set p = Nothing
    End Sub

     

    Solução 2:

    Segue a solução do seu problema: (Nesta solução você consegue alterar o tamanho da imagem)

    - Insira um botão em sua planilha

    - Clique com o botão direito em seu botão e clique em Atribuir macro

    - Será solicitado o nome da macro: coloque Pasta1!Inserir_clique e clique em Novo

    - Será exibido seu Módulo1 que será exibido o seguinte:

    Sub Inserir_clique()

    End Sub

    Adicione a seguinte linha:

    Sub Inserir_clique()
    'Chamada da procedure de importação da imagem
    ImportPictureInRange
    End Sub

    Em seguida crie a seguinte procedure:

    Sub ImportPictureInRange()
    'O range definido definirá o tamanho da imagem
        InsertPictureInRange "C:\Users\Carlos Citrangulo\Pictures\partner_network.jpg", Range("B5:D10")
    End Sub

    Em seguida crie mais esta procedure:

    Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
    ' insere uma imagem e redimensiona-lo para ajustar o intervalo TargetCells
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
        If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
        If Dir(PictureFileName) = "" Then Exit Sub
        ' importar imagem
        Set p = ActiveSheet.Pictures.Insert(PictureFileName)
        ' determine posições
        With TargetCells
            t = .Top
            l = .Left
            w = .Offset(0, .Columns.Count).Left - .Left
            h = .Offset(.Rows.Count, 0).Top - .Top
        End With
        ' posição da imagem
        With p
            .Top = t
            .Left = l
            .Width = w
            .Height = h
        End With
        Set p = Nothing
    End Sub

     

    Caro Mauro, fiz este algoritmo aqui e funcionou perfeitamente, qualquer dúvida estou a disposição, no meu blog você encontrará bastante dicas, artigos e vagas, não deixe de visitá-lo.

    Espero ter ajudado, se sim, por favor qualificar.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    • Sugerido como Resposta Carlos C Citrangulo Jr quarta-feira, 27 de abril de 2011 03:25
    • Marcado como Resposta MauroMeira quarta-feira, 27 de abril de 2011 12:13
    quarta-feira, 27 de abril de 2011 03:25
  • Caro Mauro bom dia!

    Obrigado pelo reconhecimento isso é importante para que possamos continuar com este trabalho nas comunidades.

    Segue a nova solução:

    Sub Inserir_Click()
     ImportPictureInRange
    End Sub

    Sub ImportPictureInRange()
    Dim Arquivo As String
    Arquivo = Application.GetOpenFilename
    'O range definido definirá o tamanho e o local de posicionamento da imagem, se você colocar por exemplo A1:J10, sua imagem ficará maior ainda.
    InsertPictureInRange Arquivo, Range("A1:D10")
    End Sub

    Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
    ' insere uma imagem e redimensiona-lo para ajustar o intervalo TargetCells
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
        If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
        If Dir(PictureFileName) = "" Then Exit Sub
        ' importar imagem
        Set p = ActiveSheet.Pictures.Insert(PictureFileName)
        ' determine posições
        With TargetCells
            t = .Top
            l = .Left
            w = .Offset(0, .Columns.Count).Left - .Left
            h = .Offset(.Rows.Count, 0).Top - .Top
        End With
        ' posição da imagem
        With p
            .Top = t
            .Left = l
            .Width = w
            .Height = h
        End With
        Set p = Nothing
    End Sub

    Espero ter ajudado, se sim por favor qualificar.
    No meu blog você encontrará mais dicas.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    • Sugerido como Resposta Carlos C Citrangulo Jr quarta-feira, 27 de abril de 2011 13:33
    • Marcado como Resposta MauroMeira quarta-feira, 27 de abril de 2011 14:00
    quarta-feira, 27 de abril de 2011 13:33

Todas as Respostas

  • Olá Mauro boa noite,

    Temos 2 soluções:

    Solução 1:

    Segue a solução do seu problema: (Nesta solução você não consegue alterar o tamanho da imagem, mas acho interessante você entender e poder utilizar também)

    - Insira um botão em sua planilha

    - Clique com o botão direito em seu botão e clique em Atribuir macro

    - Será solicitado o nome da macro: coloque Pasta1!Inserir_clique e clique em Novo

    - Será exibido seu Módulo1 que será exibido o seguinte:

    Sub Inserir_clique()

    End Sub

    Adicione a seguinte linha:

    Sub Inserir_clique()
    'Chamada da procedure de importação da imagem
    ImportPicture
    End Sub

    Em seguida crie a seguinte procedure:

    Sub ImportPicture()
    'Caminho da sua imagem e localização na planilha, neste caso célula D10 centralizado na vertical e horizontal
        InsertPicture "C:\Users\Carlos Citrangulo\Pictures\partner_network.jpg", Range("D10"), True, True
    End Sub

    Em seguida crie mais esta procedure:

    Sub InsertPicture(PictureFileName As String, TargetCell As Range, CenterH As Boolean, CenterV As Boolean)
    ' insere uma imagem na posição do canto superior esquerdo do TargetCell
    ' a imagem pode ser centralizada horizontalmente e/ou verticalmente
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
        If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
        If Dir(PictureFileName) = "" Then Exit Sub
        ' importa imagem
        Set p = ActiveSheet.Pictures.Insert(PictureFileName)
        ' determina as posições
        With TargetCell
            t = .Top
            l = .Left
            If CenterH Then
                w = .Offset(0, 1).Left - .Left
                l = l + w / 2 - p.Width / 2
                If l < 1 Then l = 1
            End If
            If CenterV Then
                h = .Offset(1, 0).Top - .Top
                t = t + h / 2 - p.Height / 2
                If t < 1 Then t = 1
            End If
        End With
        'posição da imagem
        With p
            .Top = t
            .Left = l
        End With
        Set p = Nothing
    End Sub

     

    Solução 2:

    Segue a solução do seu problema: (Nesta solução você consegue alterar o tamanho da imagem)

    - Insira um botão em sua planilha

    - Clique com o botão direito em seu botão e clique em Atribuir macro

    - Será solicitado o nome da macro: coloque Pasta1!Inserir_clique e clique em Novo

    - Será exibido seu Módulo1 que será exibido o seguinte:

    Sub Inserir_clique()

    End Sub

    Adicione a seguinte linha:

    Sub Inserir_clique()
    'Chamada da procedure de importação da imagem
    ImportPictureInRange
    End Sub

    Em seguida crie a seguinte procedure:

    Sub ImportPictureInRange()
    'O range definido definirá o tamanho da imagem
        InsertPictureInRange "C:\Users\Carlos Citrangulo\Pictures\partner_network.jpg", Range("B5:D10")
    End Sub

    Em seguida crie mais esta procedure:

    Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
    ' insere uma imagem e redimensiona-lo para ajustar o intervalo TargetCells
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
        If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
        If Dir(PictureFileName) = "" Then Exit Sub
        ' importar imagem
        Set p = ActiveSheet.Pictures.Insert(PictureFileName)
        ' determine posições
        With TargetCells
            t = .Top
            l = .Left
            w = .Offset(0, .Columns.Count).Left - .Left
            h = .Offset(.Rows.Count, 0).Top - .Top
        End With
        ' posição da imagem
        With p
            .Top = t
            .Left = l
            .Width = w
            .Height = h
        End With
        Set p = Nothing
    End Sub

     

    Caro Mauro, fiz este algoritmo aqui e funcionou perfeitamente, qualquer dúvida estou a disposição, no meu blog você encontrará bastante dicas, artigos e vagas, não deixe de visitá-lo.

    Espero ter ajudado, se sim, por favor qualificar.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    • Sugerido como Resposta Carlos C Citrangulo Jr quarta-feira, 27 de abril de 2011 03:25
    • Marcado como Resposta MauroMeira quarta-feira, 27 de abril de 2011 12:13
    quarta-feira, 27 de abril de 2011 03:25
  • Bom dia Carlos Carvalho

    Ficou ótimo, perfeito.

    Eu pesso desculpas, mas, posso abusar um pouco?

    Dentro da solução nº 2, temos a inclusão de uma figura apenas, é possível incrementar este código para abrir uma caixa de diálogo para incluir na planilha qualquer figura e fosse deletada a anterior, e sua posição fosse rente ao canto superir esquerdo da planilha?

     

    Obrigado pela sua atenção na ajuda, realmente foi de grande valia.

    Abraço

    Mauro


    quarta-feira, 27 de abril de 2011 12:42
  • Caro Mauro bom dia!

    Obrigado pelo reconhecimento isso é importante para que possamos continuar com este trabalho nas comunidades.

    Segue a nova solução:

    Sub Inserir_Click()
     ImportPictureInRange
    End Sub

    Sub ImportPictureInRange()
    Dim Arquivo As String
    Arquivo = Application.GetOpenFilename
    'O range definido definirá o tamanho e o local de posicionamento da imagem, se você colocar por exemplo A1:J10, sua imagem ficará maior ainda.
    InsertPictureInRange Arquivo, Range("A1:D10")
    End Sub

    Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
    ' insere uma imagem e redimensiona-lo para ajustar o intervalo TargetCells
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
        If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
        If Dir(PictureFileName) = "" Then Exit Sub
        ' importar imagem
        Set p = ActiveSheet.Pictures.Insert(PictureFileName)
        ' determine posições
        With TargetCells
            t = .Top
            l = .Left
            w = .Offset(0, .Columns.Count).Left - .Left
            h = .Offset(.Rows.Count, 0).Top - .Top
        End With
        ' posição da imagem
        With p
            .Top = t
            .Left = l
            .Width = w
            .Height = h
        End With
        Set p = Nothing
    End Sub

    Espero ter ajudado, se sim por favor qualificar.
    No meu blog você encontrará mais dicas.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    • Sugerido como Resposta Carlos C Citrangulo Jr quarta-feira, 27 de abril de 2011 13:33
    • Marcado como Resposta MauroMeira quarta-feira, 27 de abril de 2011 14:00
    quarta-feira, 27 de abril de 2011 13:33
  • Bom dia Carlos Carvalho

    Sinceramente, ficou melhor que excelente,

    É isso mesmo, valeu, muito obrigado.

    Cumpriu minha necessidade em 100%, com o seu código minha planilha será completa.

    Obrigado mesmo.

    São pessoas do seu nível que faz as comunidades existir, porque, nós que sabemos pouco e estamos sempre querendo aperfeiçoar precisamos muito desta ajuda que VC e os outros amigos que estão de prontidão dando suporte..

    Abraço

    Mauro

    quarta-feira, 27 de abril de 2011 14:23