Bilder mit Makro zwischen zwei Tabellenblaetter kopieren

[Nore47]

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

[Nore47]

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)

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

Kann mir einer helfen?

LG

Bernhard

[Stephan]

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.

dann wäre doch eigentlich zu empfehlen das Bild direkt in die Datei zupacken, wie z.B. hier für ein PDF beschrieben ist:
viewtopic.php?f=25&t=65927



Gruß
Stephan

[Nore47]

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

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