Este fórum foi descontinuado. LEIA AQUI e participe da Comunidade BABOO :)

Ir para conteúdo
rafael leite

RESPONDIDO Inserir imagens redimensionadas nas celulas do excel

Mensagem Recomendada

Preciso de ajuda com uma macro no excel, meu objetivo é criar uma macro em que eu possa trabalhar da seguinte maneira: Que poderia ADICIONAR uma foto/imagem numa célula SELECIONADA, mas que esta foto pudesse AUTOMATICAMENTE se redimensionar à célula...o máximo que consegui foi isso mas a foto nao redimensiona;

 

Sub inserir_Click()

 Dim Pict
    Dim ImgFileFormat As String
    Dim Celula As String
    Celula = "A1"
    ImgFileFormat = "Image Files JPG (*.jpg),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
    Pict = Application.GetOpenFilename(ImgFileFormat)
    If Pict = False Then End
   Application.ActiveSheet.Shapes.AddPicture Pict, False, True, Range(Celula).Left, _
    Range(Celula).Top, Range(Celula).Height * 12, Range(Celula).Width * 3
End Sub
 

 

tentarei mandar imagem de uma planilha com um exemplo. por favor quem souber me ajude, trabalho com fotografias e isso poderia me ajudar muito!!

post-587717-0-19271300-1454504099_thumb.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá, Rafael.

Experimente este código.

Sub inserir_Click()  Dim Pict, ImgFileFormat As String, C As Range    Set C = ActiveCell    ImgFileFormat = "Image Files JPG (*.jpg),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"    Pict = Application.GetOpenFilename(ImgFileFormat)    If Pict = False Then End   Application.ActiveSheet.Shapes.AddPicture Pict, False, True, C.Left, _    C.Top, C.Height, C.WidthWith ActiveSheet.Shapes(ActiveSheet.Shapes.Count)    .LockAspectRatio = False     .Top = C.Top    .Left = C.Left    .Height = C.RowHeight    .Width = C.WidthEnd WithEnd Sub

obs.

1. o código irá colocar a foto junto da célula ativa, então, se por exemplo, quiser inserir a foto junto da célula 'C3' selecione aquela célula e rode o código

2. a foto inserida será dimensionada com dimensões iguais às dimensões da célula ativa por isso se a proporção original entre largura e altura da foto não for igual à proporção entre largura e altura da célula a foto será distorcida; para manter a proporção original e assim evitar a distorção da foto altere o comando para  .LockAspectRatio =True, dessa forma a largura da foto ficará igual à largura da célula e a altura poderá ficar diferente, e esta poderá ser ajustada manualmente


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá, Rafael.

Experimente este código.

Sub inserir_Click()  Dim Pict, ImgFileFormat As String, C As Range    Set C = ActiveCell    ImgFileFormat = "Image Files JPG (*.jpg),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"    Pict = Application.GetOpenFilename(ImgFileFormat)    If Pict = False Then End   Application.ActiveSheet.Shapes.AddPicture Pict, False, True, C.Left, _    C.Top, C.Height, C.WidthWith ActiveSheet.Shapes(ActiveSheet.Shapes.Count)    .LockAspectRatio = False     .Top = C.Top    .Left = C.Left    .Height = C.RowHeight    .Width = C.WidthEnd WithEnd Sub

obs.

1. o código irá colocar a foto junto da célula ativa, então, se por exemplo, quiser inserir a foto junto da célula 'C3' selecione aquela célula e rode o código

2. a foto inserida será dimensionada com dimensões iguais às dimensões da célula ativa por isso se a proporção original entre largura e altura da foto não for igual à proporção entre largura e altura da célula a foto será distorcida; para manter a proporção original e assim evitar a distorção da foto altere o comando para  .LockAspectRatio =True, dessa forma a largura da foto ficará igual à largura da célula e a altura poderá ficar diferente, e esta poderá ser ajustada manualmente

obgo pela ajuda.

Compartilhar este post


Link para o post
Compartilhar em outros sites

×
×
  • Criar Novo...