Gostaria de uma macro que inseri um tipo de foto de acordo com o valor de uma célula.
Célula com o valor 1, inseri foto tipo 1
Na mesma célula valor 2, inseri foto tipo 2 e assim sucessivamente.
Ola @Raposo, seja bem vindo ao Grupo.
Se entendi na célula que tiver digitado, por exemplo, 1.png, a macro devera pegar a foto 1.png de um diretório pré definido e colar nesta célula
Seria algo assim: Você digita o nome da foto em uma célula (ou agrupamento) e aciona a macro, ela busca a foto e cola neste local.
É isso ?
USE comentar para dar resposta a um comentário, OK.
OU edite sua pergunta.
Sim, fiz essa macro no excel e funcionou, só que no libreoffice não.
Sub Carregar_foto()
'C:\MC
Range("c66") = ThisWorkbook.Path & "\" & Range("j40") & ".jpg"
ActiveSheet.Shapes("Foto_apoio").Fill.UserPicture Range("c66")
End Sub
Poderia me ajudar para que ela funcione no libreoffice?
Olá @Raposo .
Segue código com base na wiki do Libreoffice
Wiki: Fonte: The Structure of Drawings - Apache OpenOffice Wiki
Código:
Sub AddImg
Dim GraphicObjectShape As Object
Dim Point As New com.sun.star.awt.Point
Dim Size As New com.sun.star.awt.Size
Dim Page As Object
Dim oImg as String
oDoc = ThisComponent
Page = oDoc.DrawPages(0) 'Posição da planilha no seu arquivo. Planilha1 = 0
oPlan = oDoc.Sheets.getByName("Planilha1")
'Pode ser utilizado qualquer uma das duas linhas abaixo. Para trocar, retire o apostrofe (') da linha de códido a frente
'Caso escolha colocar o link de acesso da imagem aqui dentro, é necessário alterar o endereço
oImg = oPlan.getCellRangeByName("A1").String 'Aqui pega o link da célula
'oImg = "C:\Users\Public\Pictures\Sample Pictures\" & oPlan.getCellRangeByName("A2").String & ".jpg" 'Aqui pega o nome da célula
Call DeletaImg
Point.x = 1000 'Posição X da planilha
Point.y = 1000 'Posição Y da planilha
Size.Width = 2000 'Largura da imagem
Size.Height = 2000 'Altura da imagem
GraphicObjectShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
GraphicObjectShape.Size = Size
GraphicObjectShape.Position = Point
GraphicObjectShape.GraphicURL = ConvertToUrl(oImg)
Page.add(GraphicObjectShape)
End Sub
Acrescentar macro para deletar.
Sub DeletaImg()
'Fonte: https://stackoverflow.com/questions/46048667/how-to-delete-all-images-from-all-sheets-of-a-libreoffice-calc-workbook
Dim oDrawPage As Object
Dim oShape As Object
oDrawPage = oDoc.getSheets().getByName("Planilha1").getDrawPage()
oShape = oDrawPage.getByIndex(1) 'sempre será a última imagem
oDrawPage.remove(oShape)
End SubEsse código é o que eu quero, mas tem um detalhe eu gostaria de quando colocar outra foto, a anterior seja deletada, tem como acrescentar mas esse código nessa macro?
Substitui o nome planilha 1 pela minha planilha, mas deu erro nessa linha. Esta dando esse erro:
Erro de execução do BASIC.
Variável do objeto não definida.
@Raposo, a macro está buscando o link de uma célula ou você colocou o link dentro da macro? Se o link estiver dentro da macro, verifique se o endereço está correto. Caso vc utilizou a macro como lhe passei, pode ser ai o erro que está apresentando. Se quiser, me envie uma cópia do arquivo com dados fictícios para te ajudar melhor. consultoria.conradobueno@gmail.com
Olá @Raposo, segue mais um exemplo:
'=====================================================================
Sub CelulaStringImagemColar
'=====================================================================
' Exemplo
' Call Imagem ( "Planilha1.AD8", 7600, 5800, 1, 57 )
' Planilha1.AD8 = célula onde esta o caminho da foto
' exemplo: C:/Users/GILBERTO/Dropbox/Public/ask.libreoffice/Fotos/3010002.png
' 7600, e 5800 = Largura e Altura da imagem em centésimos de mm ( 1000 = 1 cm )
' 1, 57 = numero da Coluna e da Linha ( ambos iniciam com zero )
'=====================================================================
Call Imagem ( "Planilha1.A1", 7600, 5800, 0, 10 )
' Call Imagem ( "Planilha1.A2", 7600, 5800, 0, 24 )
' Caso for mais que uma imagem, é so acrescentar a chamada "Call Imagem" com os parametros.
End Sub
'=====================================================================
Sub Imagem ( x As String, a As Integer, b As Integer, c As Integer, d As Integer )
Dim oDoc As Object
Dim oPaginaAtiva As Object
Dim oImagen As Object
Dim oTam As New com.sun.star.awt.Size
Dim oPlan As Object
Dim oCel As Object
Dim Var1 As String
x1 = Split( x, "." )
oPlan = thisComponent.Sheets.getByName( x1(0) )
Var1 = oPlan.getCellRangeByName( x1(1) ).String
oDoc = ThisComponent
sCaminho = ConvertToURL( Var1 )
oPaginaAtiva = oDoc.getCurrentController.getActiveSheet.getDrawPage()
oImagen = oDoc.createInstance( "com.sun.star.drawing.GraphicObjectShape" )
oImagen.GraphicURL = sCaminho
oPaginaAtiva.add( oImagen )
oTam.Width = a 'em centésimos de milimitros
oTam.Height = b 'em centésimos de milimitros
oImagen.setSize( oTam )
oCelda = ThisComponent.getCurrentController.getActiveSheet.getCellByPosition( c,d )
oImagen.Anchor = oCelda
End Sub