Bild mit Makro einfügen nicht verlinken

[Nore47]

Hallo,

will in Calc mit einem Makro ein Bild einfügen. - Aber richtig einfügen - damit eine Kopie auch im "Container" gespeichert wird.

Achtung ! Keinen Link erstellen.

Das erste Makro (hab ich irgendwo runtergeladen) habe ich umschreiben können. Aber es erstellt nur einen Link.
(d.h. wenn die Originaldatei gelöscht ist, ist das Bild in Calc auch weg.)

Code: Alles auswählen

REM  *****  BASIC  *****
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")
   oCell = mySheet.getCellRangeByName("A1")
   GrafikName = ConvertToURL(oCell.String)
   NewGrafik.GraphicURL=GrafikName
   NewGrafik.name = GrafikName
   oCell = mysheet.getcellRangebyName("C5")'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 * 20 'Grösse festlegen
   oGrafikGroesse.width = breite * 20
   NewGrafik.setSize(oGrafikGroesse)
End Sub

Das 2 Makro ist der Originaldownload von dem 3 Makro.

Code: Alles auswählen

REM  *****  BASIC  *****
Sub Bild2einfuegen
sImgPath = "C:\DSC02329.JPG" 'Pfad zum Bild
nWidth = 5000 'Breite
nHeight = 7000 'Höhe
sImgPath = ConvertToUrl(sImgPath)
oDoc = thisComponent
oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
oBitmaps.insertByName( "myPic", sImgPath )
oPic = oBitmaps.getByName( "myPic" )
oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
With oGraph
   .GraphicURL = oPic
   .AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
   .Width = nWidth
   .Height = nHeight
End With
oCursor = oDoc.CurrentController.getViewCursor
If NOT isEmpty(oCursor.TextTable) Then
   oCursor.Cell.insertTextContent(oCursor,oGraph,False)
ElseIf NOT isEmpty(oCursor.TextFrame) Then
   oCursor.TextFrame.insertTextContent(oCursor,oGraph,False)
Else
   oDoc.Text.insertTextContent(oCursor,oGraph,False)
End If

End sub

Das 3 Makro habe ich nicht zum Laufen gebracht.
Ich wollte das 2 Makro mit dem ersten ergänzen, um es so zum laufen zu bringen.
Ich verstehe auch diesem Cod nicht richtig.
Es kommt ein Fehler in der Zeile wo "myPic" steht. Aber ich kann mit "myPic" nichts anfagen.

Code: Alles auswählen

Sub Test


Dim Original_SizePixel As New com.sun.star.awt.Size
Dim Size_max As New com.sun.star.awt.Size
Dim Size As New com.sun.star.awt.Size

    Size_max.Width=5000 'maximale Breite
    Size_max.Height=3000 'maximale Höhe


    sImgPath = "C:\C:\DSC02329.JPG" 'Pfad zum Bild
    sImgPath = ConvertToUrl(sImgPath)
    oDoc = thisComponent

    oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
    oBitmaps.insertByName( "myPic", sImgPath )
    oPic = oBitmaps.getByName( "myPic" )
    oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")   
    With oGraph
       .GraphicURL = oPic
       .AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
    End With

    oCursor = oDoc.CurrentController.getViewCursor
    If NOT isEmpty(oCursor.TextTable) Then
       oCursor.Cell.insertTextContent(oCursor,oGraph,False)
    ElseIf NOT isEmpty(oCursor.TextFrame) Then
       oCursor.TextFrame.insertTextContent(oCursor,oGraph,False)
    Else
       oDoc.Text.insertTextContent(oCursor,oGraph,False)
    End If

    Original_SizePixel = oGraph.Graphic.SizePixel
   
    Factor_Width=Size_max.width/Original_SizePixel.width
    Factor_Height=Size_max.Height/Original_SizePixel.Height

    if Factor_Width<=Factor_Height then 'bestimmen ob die Breite oder die Höhe der begrenzende Faktor ist
      factor = Factor_Width
    else
      factor = Factor_Height
    endif

    size.width = Original_SizePixel.width*factor
    size.Height = Original_SizePixel.Height*factor

    oGraph.size=size
   
    end sub

Wenn auch der versuch mit Makro 2 und 3 nicht läuft - viel wichtiger währe mir der Befehl zum Einfügen im Makro 1.

Wie ist der Befehl ein Bild per Makro einzufügen (und nicht verlinken) ?

Es funktioniert bei mir nur mit "drag and drop" das kann ich mit dem Makrorekorder nicht aufzeichnen.

Über Menü Einfügen .... funktioniert es auch nicht.


Danke.

LG

Bernhard

[komma4]

Die Makros 2 und 3 sind für Writer (TextTable gibt's nur dort).

Schau' mal in Andrew Pitonyaks Makro Dokument... der erklärt ziemlich genau, warum mittels API nur das Einfügen als Link möglich ist... und wie man es umgehen kann (s. "Danny Brewer", Kap. 5.9.2 in meiner Ausgabe des Dokuments)

Viel Erfolg!

[Stephan]

Es funktioniert bei mir nur mit "drag and drop" das kann ich mit dem Makrorekorder nicht aufzeichnen.

Über Menü Einfügen .... funktioniert es auch nicht.

Dann nenne bitte Deine Programmversion denn das Aufzeichnen sollte funktionieren.

Meine Vermutung ist aber eher das Du das Programm fehlbedienst und bei der Makroaufzeichnung nicht beachtest das die Verknüpfungsoption im Dateidialog deaktiviert sein muss.
Ebenso dürfte die gewünschte Funktion von drag und drop hier nur zufällig sein, weil Du Dir garnicht bewusst bist wie Du das dabei steuern kannst und das Einfügen ohne Verknüpfung lediglich der Default ist, Einfügen mit Verknüpfung beim drag und drop geht z.B. mit Festhalten von UMSCHALT+STRG.

Ich erhalte z.B. mit OOo 3.3.0 beim Aufzeichnen folgendes Makro:

Code: Alles auswählen

sub Main
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(2) as new com.sun.star.beans.PropertyValue
args1(0).Name = "FileName"
args1(0).Value = "file:///C:/Users/Public/Pictures/Sample%20Pictures/Chrysanthemum.jpg"
args1(1).Name = "FilterName"
args1(1).Value = "<Alle Formate>"
args1(2).Name = "AsLink"
args1(2).Value = false

dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args1())

end sub

der dort für Deine Frage wichtige Teil ist:

Code: Alles auswählen

args1(2).Name = "AsLink"
args1(2).Value = false

stünde dort:

Code: Alles auswählen

args1(2).Name = "AsLink"
args1(2).Value = true

wäre das Bild verlinkt.


Gruß
Stephan

[Stephan]

Die Makros 2 und 3 sind für Writer (TextTable gibt's nur dort).

Schau' mal in Andrew Pitonyaks Makro Dokument... der erklärt ziemlich genau, warum mittels API nur das Einfügen als Link möglich ist... und wie man es umgehen kann (s. "Danny Brewer", Kap. 5.9.2 in meiner Ausgabe des Dokuments)

Viel Erfolg!

Hallo Winfried,

ich habe hier die deutsche Übersetzung des Pitonyaks Dokuments mit Datum vom 28. Dezember 2015 und ich finde diese Erklärungen nicht. Gibt es dort bei der Erklärung ein markantes Wort wonach ich suchen kann z.B. ein Makroname oder Variablenname in Makro?


Gruß
Stephan

[komma4]

Stephan,

uff - in der zitierten englischen Version (23.05.2005, 23:28:34) ist es die erste Fundstelle von "Brewer" (sonst meist "DannyB" genannt).

5.9.2. Danny Brewer embeds a graphic
Danny Brewer figured out how to load a bitmap into the document and then obtain the URL of the loaded bitmap. The com.sun.star.drawing.BitmapTable service loads the image.
Listing 5.25: Insert the image into the internal bitmap table.

Code: Alles auswählen

REM Given a URL to an external graphic resource,
REM  load that graphic permanently into this drawing document,
REM  and return a new URL to the internal resource.
REM The new URL can be used in place of the old URL.
Function LoadGraphicIntoDocument( oDoc As Object, cUrl$, cInternalName$ ) As String
  Dim oBitmaps
  Dim cNewUrl As String

  ' Get the BitmapTable from this drawing document.
  ' It is a service that maintains a list of bitmaps that are internal
  '  to the document.
  oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )

  ' Add an external graphic to the BitmapTable of this document.
  oBitmaps.insertByName( cInternalName, cUrl )
   
  ' Now ask for it back.
  ' What we get back is an different Url that points to a graphic
  '  which is inside this document, and remains with the document.
  cNewUrl = oBitmaps.getByName( cInternalName )
   
  LoadGraphicIntoDocument = cNewUrl
End Function

Loading the bitmap into the document does not display the bitmap. The internal bitmap can be used with either Listing 5.22 or Listing 5.23 to insert a graphic that is stored inside of the document. The following macro inserts the same graphic using two different methods. Either will work, depending upon whether you desire an embedded or a linked graphic. Note that oBitmaps.getByName(“DBGif”) returns the URL of the embedded image in the form vnd.sun.star.GraphicObject:<big hex number>.
Listing 5.26: You can insert as an external or an internal link.

Code: Alles auswählen

  Dim sURL$
  Dim oBitmaps
  Dim s$

  REM Insert a reference to the external file
  sURL = "file:///andrew0/home/andy/db.gif"
  InsertGraphicObject(ThisComponent, sURL)

  REM Insert a reference to an internally contained graphic.
  S = "com.sun.star.drawing.BitmapTable"
  oBitmaps = ThisComponent.createInstance( s )
  LoadGraphicIntoDocument(ThisComponent, sURL, "DBGif")
  InsertGraphicObject(ThisComponent, oBitMaps.getByName("DBGif"))

...und auch noch

5.9.4. Embed a graphics directly
The following method, requires OOo version 2.0 or later. I do not have the time to explain how it works, but it is certainly useful.
Listing 5.28: Embed a graphic into a document.

Code: Alles auswählen

Sub EmbedGraphic(oDoc, sURL$)
  REM Author: Stephan Wunderlich
  Dim oShape
  Dim oGraph     'The graphic object is text content.
  Dim oProvider  'GraphicProvider service.
  Dim oText
  Dim s$

  s = "com.sun.star.drawing.GraphicObjectShape"
  oShape = oDoc.createInstance(s)
  oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")

  oDoc.getDrawPage().add(oShape)

  oProvider = createUnoService("com.sun.star.graphic.GraphicProvider")

  Dim oProps(0) as new com.sun.star.beans.PropertyValue
  oProps(0).Name  = "URL"
  oProps(0).Value = sURL

  oShape.Graphic = oProvider.queryGraphic(oProps())
  oGraph.graphicurl = oShape.graphicurl
  oText= oDoc.getText()

  ' Insert at the current cursor location
  Dim oVC : oVC = oDoc.getCurrentController().getViewCursor()
  oText.insertTextContent(oVC, oGraph, false)

  ' We no longer require the shape object.
  oDoc.getDrawPage().remove(oShape)
End Sub  

Alle Beispiele *nicht* ausprobiert

[Stephan]

uff - [...]

Danke fürs Raussuchen, wobei ich es trotz Deines langen Zitats in meiner Dokumentversion nicht auffinden kann, das macht aber nichts denn ich konnte es ja nun per Deines Zitats lesen.

Alle Beispiele *nicht* ausprobiert

überhaupt kein Problem, denn es war garnicht meine Absicht Dir zu widersprechen, sondern ich selbst kannte auch keinen nativen Code und fühlte mich nur wegen der Aussage des Fragers zur Makroaufzeichung herausgefordert.



Gruß
Stephan

[komma4]

trotz Deines langen Zitats in meiner Dokumentversion nicht auffinden kann

Kein Problem.
Nach Deiner Einlassung dachte ich mir schon, dass es in der deutschen Version nicht vorhanden ist - deshalb das lange Zitat.

Wenn ich sonst Code poste ist der ausprobiert und somit lauffähig, deshalb die Einschränkung.

[Nore47]

Hallo Komma4 und Stephan,

danke für die Antworten.

Es funktioniert jetzt. Ich hab scheinbar vor lauter Bäumen den Wald nicht mehr gesehen.

Ich habe beim Einfügen, wie du bereits erwähnt hast verlinkt und habe keine Lösung gefunden die ich mit den Makrorekorder aufzeichnen konnte. Ich weiß von MS den Unterschied, hab auch danach gesucht, aber habe mich so auf den Link und die Fehlersuche so festgesetzt das ich die Version mit dem Bild einfügen und den Hacken als Link einfügen offensichtlich nicht gesehen habe.

Mich verwirrt aber jetzt, das ich die Fehlbedienung scheinbar ein Paar Wochen wiederholt habe - vor einer halben Stunde habe ich es nachvollziehen können - jetzt bei diesem Schreiben finde ich diese Version nicht mehr. Ich finde nur noch die neue Version !?
Ich muß die Sache nochmals ein paar Tage beobachten - vermutlich mache ich noch irgendwo eine Fehlbedienung die auf das Menü Einfluss nimmt.

Ich weiß jetzt zumindest dass es und wie es Funktioniert und kann jetzt ggf. anders suchen.


Danke auch für den Hinweis für das Skript "Andrew Pitonyaks Makro", so was habe ich ach schon eine weile gesucht, da sind auch Einzelheiten zum
exakten Nachlesen beschrieben.

Ich hab meistens über Google gearbeitet - und wurde meistens erschlagen von vielen ungeeigneten Sachen.
Das meiste habe ich auf der Seite von "starbasic dannenhoefer" gefunden und verwendet. Dem auch vielen Dank.

LG

Bernhard