Eu tenho um código que adiciona imagens em células específicas. Mas só que esse macro adiciona as fotos nessas células e as imagens ficam redimensionadas no tamanho das células específicas.
Como faço para alterar esse código e fazer com que as imagens fiquem no seu tamanho original quando forem adicionadas?
Código: Sub Carregar_Pares_Imagens() Dim Pict As Variant, ImgFileFormat As String, rgMescladas As Range, i As Long 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, False, True) If IsArray(Pict) Then If UBound(Pict) > 6 Then MsgBox "Selecionar apenas 6 imagens" Exit Sub End If For i = 1 To UBound(Pict) Set rgMescladas = ActiveSheet.Cells(RowIndex:=Array(21, 53)((i - 1) \ 3), _ ColumnIndex:=Array("B", "J", "R")((i - 1) Mod 3)) If rgMescladas.MergeCells Then Set rgMescladas = rgMescladas.MergeArea rgMescladas.Worksheet.Shapes.AddPicture Filename:=Pict(i), _ LinkToFile:=msoFalse, _ SaveWithDocument:=msoTrue, _ Left:=rgMescladas.Left, _ Top:=rgMescladas.Top, _ Width:=rgMescladas.Width, _ Height:=rgMescladas.Height Next i End If End Sub
Pergunta
Edson Guilherme
Eu tenho um código que adiciona imagens em células específicas. Mas só que esse macro adiciona as fotos nessas células e as imagens ficam redimensionadas no tamanho das células específicas.
Como faço para alterar esse código e fazer com que as imagens fiquem no seu tamanho original quando forem adicionadas?
Código:
Sub Carregar_Pares_Imagens()
Dim Pict As Variant, ImgFileFormat As String, rgMescladas As Range, i As Long
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, False, True)
If IsArray(Pict) Then
If UBound(Pict) > 6 Then
MsgBox "Selecionar apenas 6 imagens"
Exit Sub
End If
For i = 1 To UBound(Pict)
Set rgMescladas = ActiveSheet.Cells(RowIndex:=Array(21, 53)((i - 1) \ 3), _
ColumnIndex:=Array("B", "J", "R")((i - 1) Mod 3))
If rgMescladas.MergeCells Then Set rgMescladas = rgMescladas.MergeArea
rgMescladas.Worksheet.Shapes.AddPicture Filename:=Pict(i), _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=rgMescladas.Left, _
Top:=rgMescladas.Top, _
Width:=rgMescladas.Width, _
Height:=rgMescladas.Height
Next i
End If
End Sub
Link para o comentário
Compartilhar em outros sites
2 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.