Notifications
Clear all

Inserir imagens em tamanho exato

4 Posts
3 Usuários
0 Reactions
870 Visualizações
(@evilmaax)
Posts: 82
Trusted Member
Topic starter
 

Bom dia.
Estou inserindo imagens em uma planilha, porém, queria que quando a imagem fosse inserida, ficasse no tamanho certo do quadrado sem ter que ficar redimensionando, porque várias pessoas vão usar. Assim evitaria o máximo de erros possíveis.
Alguma sugestão?

Obrigado

 
Postado : 07/07/2015 7:12 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Muito genérica sua demanda.
Tente adaptar

For Each cel In myrng
    If img = cel.Value Then
        With ActiveSheet.Range(cel.Address)
            Set YourPic = .Parent.Pictures.Insert(sDir)
            YourPic.Top = .Top
            'Altera as dimensões da imagem para um quadrado de 4,5 cm podendo "distorcer" a imagem
                'YourPic.ShapeRange.LockAspectRatio = msoFalse
                'YourPic.ShapeRange.Height = 127.5
                'YourPic.ShapeRange.Width = 127.5
            'Altera as dimensões da imagem para uma altura de 4,5 cm procurando reduzir a largura proporcionalmente
            'mantendo o aspecto da imagem
                'YourPic.ShapeRange.LockAspectRatio = msoTrue
                'YourPic.ShapeRange.Height = 127.5
            'Altera as dimensões da imagem para um percentual de seu tamanho original
            'no exemplo abaixo reduz as dimensões para 1/4 de seu tamanho orginal,
            'podendo "distorcer" a imagem se altura ou largura tiver um coeficiente diferente
            YourPic.ShapeRange.ScaleWidth 0.25, msoFalse, msoScaleFromTopLeft
            YourPic.ShapeRange.ScaleHeight 0.25, msoFalse, msoScaleFromTopLeft
            YourPic.ShapeRange.Rotation = 0#
            YourPic.Left = .Left
        End With
    End If
Next

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 07/07/2015 8:36 am
Issamu
(@issamu)
Posts: 605
Honorable Member
 

Outra sugestão para você adaptar:

Sub TestInsertPicture()
    InsertPicture "C:...sua imagem.jpg", _
        Range("Célula onde vai a imagem"), False, False
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
    CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
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
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    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
    ' position picture
    With p
        .Top = t
        .Left = l
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = TargetCell.Height
        .Width = TargetCell.Width
    End With
    Set p = Nothing
End Sub

Rafael Issamu F. Kamimura
Moderador Oficial Microsoft Community - MCC (Contribuidor do Microsoft Community)
http://zip.net/bjrt0X - http://zip.net/bhrvbR
Foi útil? Clique na mãozinha
Conheça: http://excelmaniacos.com/

 
Postado : 07/07/2015 8:51 am
(@evilmaax)
Posts: 82
Trusted Member
Topic starter
 

Não estou conseguindo. Estou com problemas para:

1 - Coloco o código na "janela", dentro da edição VBA, chamada "EstaPasta_de_trabalho", certo?
2 - Como é uma VBA não preciso executar toda vez que inserir uma imagem, assim como faria se fosse uma macro, correto?
3 - Preciso salvá-la como "Documento habilitado para macro" ou algo do tipo? Se sim, preciso fazer isso antes de usá-la a primeira vez. ou posso usar assim que colar o código na edição?
4 - Onde exatamente eu teria de editar para que funcionasse certinho?
5 - Pro código funcionar tenho que remover as aspas simples antes de algumas linhas? Elas servem para comentários, cero? Falo isso a respeito principalmente do exemplo dado pelo Reinaldo:

For Each cel In myrng
    If img = cel.Value Then
        With ActiveSheet.Range(cel.Address)
            Set YourPic = .Parent.Pictures.Insert(sDir)
            YourPic.Top = .Top
            'Altera as dimensões da imagem para um quadrado de 4,5 cm podendo "distorcer" a imagem
                'YourPic.ShapeRange.LockAspectRatio = msoFalse
                'YourPic.ShapeRange.Height = 127.5
                'YourPic.ShapeRange.Width = 127.5
     
[....]

Obrigado pela ajuda, estou tentando achar um bom curso online de VBA. Ainda não entendo muito da programação para Office.

 
Postado : 09/07/2015 4:55 am