Hallo,
bin neu in diesem Forum,
ich bitte einige Anfangsfehler zu entschuldigen.
Ich habe 2 Bilder in der Tabelle (Sheet) Vorlage abgespeichert.
1tes Bild in A1
2tes Bild in D1
Ich will nun
Bild 1 von Tabelle Vorlage nach Tabelle1 Zelle C1 und C22 kopieren,
und
Bild 2 von Tabelle Vorlage nach Tabelle1 Zelle D11 und D32 kopieren.
Wenn ich die Zellen mit Inhalt kopiere, wird zwar der Gesamte Tabellenbreich kopiert, nur das Bild macht eine Ausnahme mit der Position.
Es gibt immer verschiebungen - auch wenn ich es an einer Zelle verankere.
Mit dem Makrorecorder wird nur 1 Bild an alle Stellen kopiert.
In den Foren und Dockumentationen finde ich auch nichts.
Es würde mir auch schon der zugriffsbefehl für die Grafik reichen (....getByName....)
PS: Ein Makro mit externen Bild einfügen habe ich gefunden - und ausprobiert - es Funktioniert.
Aber dieses will ich nicht, da der Pfad bzw. das Bild immer erreichbar sein muß.
Deshalb will ich das Bild in der Calc in einem Tabellenblatt speichern - damit es immer zu Verfügung steht - auch auf unterschiedlichen PCs.
LG
Bernahrd
Bilder mit Makro zwischen zwei Tabellenblaetter kopieren
Moderator: Moderatoren
Re: Bilder mit Makro zwischen zwei Tabellenblaetter kopieren
Habe jetzt eine ähnliche Funktion für Writer unter
>>>http://www.dannenhoefer.de/faqstarbasic ... ikenimText
>>>8.1.1 Wie kann man auf Grafiken im Text zugreifen?
>>>Grafiken innerhalb eines Writer-Dokumentes einem eigenen Container den man mit getGraphicObjects erhält.
>>>Danach kann man über getbyindex oder getbyname die einzelne Grafik holen.
>>>
>>> odoc=thiscomponent
>>> grafiken=odoc.getGraphicObjects
>>> grafik=grafiken.getbyindex(0)
>>> grafik=grafiken.getbyname("Grafik1")
gefunden.
Diese Funktion müsse auch unter calc funkionierten.
Bekomme diese Funktion aber nicht zum laufen.
Grafik würde in diesem Fall unter F5 Eingefügt.
Die Grafik aus dem Office-Container gezogen bzw. ausgewählt (es sind 2 Grafiken drin)
Kann mir einer helfen?
LG
Bernhard
>>>http://www.dannenhoefer.de/faqstarbasic ... ikenimText
>>>8.1.1 Wie kann man auf Grafiken im Text zugreifen?
>>>Grafiken innerhalb eines Writer-Dokumentes einem eigenen Container den man mit getGraphicObjects erhält.
>>>Danach kann man über getbyindex oder getbyname die einzelne Grafik holen.
>>>
>>> odoc=thiscomponent
>>> grafiken=odoc.getGraphicObjects
>>> grafik=grafiken.getbyindex(0)
>>> grafik=grafiken.getbyname("Grafik1")
gefunden.
Diese Funktion müsse auch unter calc funkionierten.
Bekomme diese Funktion aber nicht zum laufen.
Grafik würde in diesem Fall unter F5 Eingefügt.
Die Grafik aus dem Office-Container gezogen bzw. ausgewählt (es sind 2 Grafiken drin)
Code: Alles auswählen
Sub BildEinfuegen
Dim oDoc as Object
Dim mySheet as Object
Dim oCell as Object
Dim Page as Object
Dim GrafikName as String
oDoc = thisComponent
grafiken=odoc.getGraphicObjects
grafik=grafiken.getbyindex(0)
mySheet = oDoc.Sheets(0)
Page = mySheet.drawPage
NewGrafik = grafik
'NewGrafik = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
oCell = mySheet.getCellRangeByName("A1")
GrafikName = ConvertToURL(oCell.String)
if not FileExists(GrafikName) then
msgbox "Die Grafik ist nicht vorhanden!"
exit sub
end if
NewGrafik.GraphicURL=GrafikName
NewGrafik.name = GrafikName
oCell = mysheet.getcellRangebyName("F5")'Ankerposition festlegen
page.add(NewGrafik)
NewGrafik.Anchor = oCell
Dim Size As New com.sun.star.awt.Size
oBildGroesse =NewGrafik.GraphicObjectFillBitmap.GetSize
hoehe = oBildGroesse.height ' in Pixeln
breite = oBildGroesse.width 'in Pixeln
dim oGrafikGroesse as new com.sun.star.awt.Size
oGrafikGroesse.height = hoehe * 10 'Grösse festlegen
oGrafikGroesse.width = breite * 10
NewGrafik.setSize(oGrafikGroesse)
End Sub
LG
Bernhard
Re: Bilder mit Makro zwischen zwei Tabellenblaetter kopieren
dann wäre doch eigentlich zu empfehlen das Bild direkt in die Datei zupacken, wie z.B. hier für ein PDF beschrieben ist:PS: Ein Makro mit externen Bild einfügen habe ich gefunden - und ausprobiert - es Funktioniert.
Aber dieses will ich nicht, da der Pfad bzw. das Bild immer erreichbar sein muß.
Deshalb will ich das Bild in der Calc in einem Tabellenblatt speichern - damit es immer zu Verfügung steht - auch auf unterschiedlichen PCs.
viewtopic.php?f=25&t=65927
Gruß
Stephan
Re: Bilder mit Makro zwischen zwei Tabellenblaetter kopieren
Hallo Stephan,
Danke für die Antwort, ich hab es jetzt auch hin bekommen das Bild in den Container zu packen - und ohne Fehlermeldung zu öffnen.
Mein Ubuntu-Zip-Programm macht da scheinbar Probleme - Na gut dann wechsle ich halt mal kurz nach Win 10 - da funktioniert es.
Kann mir jemand noch bei folgendem Problem helfen?
Die Bilder sind lassen sich jetzt zwar einfügen, sind wie gewollt an der richtigen Stelle, sehen auch so aus wie ich die Bilder haben will,
aber wenn ich die Datei Schließe - und wieder öffne dann sind nur Rahmen mit dem Pfad in Calc. Diese kann ich auch später nicht neu laden.
Gibt es eine andern Befehl beim einfügen - damit die Bilder Dauerhaft in Calc gespeichert sind?
Hier mein Code
PS: hab hier die Sachen, die ich nicht beim Versuch nicht brauche auf Rem gesetzt - kann man ja vielleicht noch brauchen
Danke
LG Bernhard
Danke für die Antwort, ich hab es jetzt auch hin bekommen das Bild in den Container zu packen - und ohne Fehlermeldung zu öffnen.
Mein Ubuntu-Zip-Programm macht da scheinbar Probleme - Na gut dann wechsle ich halt mal kurz nach Win 10 - da funktioniert es.
Kann mir jemand noch bei folgendem Problem helfen?
Die Bilder sind lassen sich jetzt zwar einfügen, sind wie gewollt an der richtigen Stelle, sehen auch so aus wie ich die Bilder haben will,
aber wenn ich die Datei Schließe - und wieder öffne dann sind nur Rahmen mit dem Pfad in Calc. Diese kann ich auch später nicht neu laden.
Gibt es eine andern Befehl beim einfügen - damit die Bilder Dauerhaft in Calc gespeichert sind?
Hier mein Code
Code: Alles auswählen
Dim dialog1 As Object
Sub initialisieren()
Dim args(0)
tmp = ermittle_pfad()
z = _
createUnoService("com.sun.star.packages.Package")
args(0) = ThisComponent.URL
z.initialize(Args())
ebene = z.getByHierarchicalName("hilfe")
alles = ebene.getElementNames()
schreiben = _
createUnoService("com.sun.star.ucb.SimpleFileAccess")
For i = LBOUND(alles()) To UBOUND(alles())
stream = _
z.getByHierarchicalName("hilfe/" & alles(i)). _
GetInputStream()
schreiben.WriteFile(tmp & "/" & alles(i), stream)
Next i
End Sub
Rem Sub dlg_start()
Rem tmp = ermittle_pfad()
Rem DialogLibraries.LoadLibrary("Standard")
Rem dialog1 = CreateUNODialog(DialogLibraries.Standard.Dtm)
Rem dialog1.GetControl("Datum").Date = cDateToIso(Date)
Rem dialog1.Model.GetByName("cmd_hilfe").ImageURL = _
Rem tmp & "/bild.png"
Rem dialog1.Execute()
Rem End Sub
Sub hilfe_aufrufen()
tmp = ermittle_pfad()
Dim aufrufen As Object
aufrufen = _
createUnoService("com.sun.star.system.SystemShellExecute")
aufrufen.execute(tmp & "/hilfe.pdf", "", 0)
End Sub
Sub entfernen()
tmp = ermittle_pfad()
If FileExists(tmp & "/hilfe.pdf") Then
Kill tmp & "/hilfe.pdf"
End If
If FileExists(tmp & "/bild.png") Then
Kill tmp & "/bild.png"
End If
If FileExists(tmp & "/logo.png") Then
Kill tmp & "/logo.png"
End If
End Sub
Function ermittle_pfad()
pfad = _
createUnoService("com.sun.star.util.PathSettings")
ermittle_pfad = pfad.temp
End Function
Rem Sub Bild_extern_einfuegen
Rem fName = FileOpenDialog ("Bitte wählen Sie eine Datei")
Rem Print "Ausgewählte Datei: "+fName
Rem End Sub
Rem Function FileOpenDialog(title As String) As String
Rem filepicker = createUnoService("com.sun.star.ui.dialogs.FilePicker")
Rem filepicker.Title = title
Rem filepicker.execute()
Rem files = filepicker.getFiles()
Rem FileOpenDialog=files(0)
Rem End Function
Sub LOGO_aufrufen()
tmp = ermittle_pfad()
Dim aufrufen As Object
aufrufen = _
createUnoService("com.sun.star.system.SystemShellExecute")
aufrufen.execute(tmp & "/logo.png", "", 0)
End Sub
Sub BildEinfuegen
Dim oDoc as Object
Dim mySheet as Object
Dim oCell as Object
Dim Page as Object
Dim GrafikName as String
oDoc = thisComponent
mySheet = oDoc.Sheets(0)
Page = mySheet.drawPage
NewGrafik = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
Rem oCell = mySheet.getCellRangeByName("A1")
tmp = ermittle_pfad()
GrafikName = tmp & "/logo.png"
Rem GrafikName = ConvertToURL(oCell.String)
Rem msgbox GrafikName
if not FileExists(GrafikName) then
msgbox "Die Grafik ist nicht vorhanden!"
exit sub
end if
NewGrafik.GraphicURL=GrafikName
NewGrafik.name = GrafikName
oCell = mysheet.getcellRangebyName("F5")'Ankerposition festlegen
page.add(NewGrafik)
NewGrafik.Anchor = oCell
Dim Size As New com.sun.star.awt.Size
oBildGroesse =NewGrafik.GraphicObjectFillBitmap.GetSize
hoehe = oBildGroesse.height ' in Pixeln
breite = oBildGroesse.width 'in Pixeln
dim oGrafikGroesse as new com.sun.star.awt.Size
oGrafikGroesse.height = hoehe * 10 'Grösse festlegen
oGrafikGroesse.width = breite * 10
NewGrafik.setSize(oGrafikGroesse)
Rem oDoc = thisComponent
Rem mySheet = oDoc.Sheets(0)
Rem Page = mySheet.drawPage
NewGrafik = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
Rem oCell = mySheet.getCellRangeByName("A1")
GrafikName = tmp & "/logo.png"
Rem GrafikName = ConvertToURL(oCell.String)
Rem msgbox GrafikName
if not FileExists(GrafikName) then
msgbox "Die Grafik ist nicht vorhanden!"
exit sub
end if
NewGrafik.GraphicURL=GrafikName
NewGrafik.name = GrafikName
oCell = mysheet.getcellRangebyName("F10")'Ankerposition festlegen
page.add(NewGrafik)
NewGrafik.Anchor = oCell
Rem Dim Size As New com.sun.star.awt.Size
oBildGroesse =NewGrafik.GraphicObjectFillBitmap.GetSize
hoehe = oBildGroesse.height ' in Pixeln
breite = oBildGroesse.width 'in Pixeln
Rem dim oGrafikGroesse as new com.sun.star.awt.Size
oGrafikGroesse.height = hoehe * 20 'Grösse festlegen
oGrafikGroesse.width = breite * 20
NewGrafik.setSize(oGrafikGroesse)
End Sub
PS: hab hier die Sachen, die ich nicht beim Versuch nicht brauche auf Rem gesetzt - kann man ja vielleicht noch brauchen
Danke
LG Bernhard