IMPORTAR IMAGENS E FORMATAR TAMANHO

Question

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

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

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