Usuário com melhor resposta
IMPORTAR IMAGENS E FORMATAR TAMANHO

Pergunta
-
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 SubAdicione a seguinte linha:
Sub Inserir_clique()
'Chamada da procedure de importação da imagem
ImportPicture
End SubEm 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 SubEm 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 SubSoluçã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 SubAdicione a seguinte linha:
Sub Inserir_clique()
'Chamada da procedure de importação da imagem
ImportPictureInRange
End SubEm 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 SubEm 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 SubCaro 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
-
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 SubSub 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 SubSub 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 SubEspero 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
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 SubAdicione a seguinte linha:
Sub Inserir_clique()
'Chamada da procedure de importação da imagem
ImportPicture
End SubEm 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 SubEm 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 SubSoluçã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 SubAdicione a seguinte linha:
Sub Inserir_clique()
'Chamada da procedure de importação da imagem
ImportPictureInRange
End SubEm 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 SubEm 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 SubCaro 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
-
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
-
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 SubSub 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 SubSub 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 SubEspero 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
-
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