Página 1 de 1

Inserir uma imagem em diferentes folhas e células

Enviado: 08 Ago 2018 às 12:10
por nelsonfpa
Tenho um livro, com várias folhas.
Através a macro abaixo, já consegui inserir uma imagem, na folha em uso e com as dimensões que pretendo.
No entanto, precisava que ao inserir esta imagem aqui, ela aparecesse noutras folhas, em células e dimensões diferentes. (em mais duas folhas diferentes e com diferentes dimensões).
Será que há alguma forma de alterar o código, para que esse processo seja automático, ou terei de o repetir em cada uma das folhas?
Brigadão!

Código:

Sub Iserir_Logo_Departamento()
Dim Pict
Dim ImgFileFormat As String
Dim Celula As String
Celula = "logodepartamento" ' célula onde será inserido a imagem
ImgFileFormat = "Image Files JPG (*.jpg),*.jpg, Image Files PNG (*.png),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
Pict = Application.GetOpenFilename(ImgFileFormat)
If Pict = False Then End
ActiveSheet.Shapes.AddPicture Pict, False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 3, Range(Celula).Height * 5 'largura da imagem = 3 colunas e altura= 5 linhas
End Sub

Re: Inserir uma imagem em diferentes folhas e células

Enviado: 08 Ago 2018 às 13:49
por osvaldomp
Experimente:

Código: Selecionar todos
Sub Iserir_Logo_Departamento()
 Dim Pict, ImgFileFormat As String, Celula As String
 Dim Plans As Variant, Plan As Variant
  Celula = "logodepartamento" ' célula onde será inserido a imagem
   Plans = Array("Plan1", "Plan2", "Plan3")
    For Each Plan In Plans
     ImgFileFormat = "Image Files JPG (*.jpg),*.jpg, Image Files PNG (*.png),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
     Pict = Application.GetOpenFilename(ImgFileFormat)
     If Pict = False Then End
     Sheets(Plan).Shapes.AddPicture Pict, False, True, Sheets(Plan).Range(Celula).Left, _
     Sheets(Plan).Range(Celula).Top, Sheets(Plan).Range(Celula).Width * 3, Sheets(Plan).Range(Celula).Height * 5 'largura da imagem = 3 colunas e altura= 5 linhas
    Next Plan
End Sub
obs. - antes de rodar o código:
1. substitua no código "Plan1", "Plan2", "Plan3" pelos nomes das planilhas em que serão coladas as imagens
2. exclua do arquivo o nome de intervalo logodepartamento
3. ative cada uma das 3 planilhas de interesse e insira o nome logodepartamento ~~~> selecione a célula que receberá a imagem (e que também receberá o nome) menu Fórmulas / Gerenciador de Nomes / Novo / na caixa Nome cole logodepartamento / na caixa Escopo selecione o nome da planilha ativa / OK / Fechar
4. o código dimensiona a imagem em função das dimensões da célula logodepartamento em cada planilha, então dimensione aquela célula em cada uma das planilhas conforme o tamanho desejado para a imagem; se isso não for viável então estabeleça as relações altura x largura da imagem para cada planilha e retorne para ajustes no código.
5. a caixa de diálogo para a escolha da imagem será aberta para cada planilha, no entanto se a imagem for única a ser inserida nas 3 planilhas, retorne para alteração no código para abrir a caixa somente uma vez.