Hyperlinks per Makro aus Textdateilist einfügen

[chemnitzer]

Hallo zusammen
ich bin hier neu und versuche mich gerade in der Makroprogrammierung. Ich möchte folgendes erreichen :
- aus einer Textdatei als Quelle der Hyperlinks die zeilenweise abarbeiten und im Dokument dann die Hyperlinks drinn haben. Das Ziel sollen dann Bilder sein die eingefügt wurden - später auch über ein Makro. Ich habe über den Makrorecorder das Einfügen eines Hyperlinks aufgezeichnet und dann folgendes Makro daraus gemacht. Die Zeilenumbrüche nach dem Einfügen des Hyperlinks werden ausgeführt NUR SIND KEINE Hyperlinks drinn.
Makroquellcode:
sub insertHyperlink_zuB '(StrTeile As Variant)
rem ----------------------------------------------------------------------
Dim n As Integer
Dim DateiNameHypListe As String

rem define variables
dim document as Object
dim dispatcher as Object
dim document1 as Object
dim dispatcher1 as Object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
rem document und dispatcher in document1 und dispatcher1 retten
rem damit sie wieder neu zugewiesen werden können
rem ----------------------------------------------------------------------
document1 = document
dispatcher1 = dispatcher
dim args1(4) as new com.sun.star.beans.PropertyValue
dim args2(4) as new com.sun.star.beans.PropertyValue
dim args3(1) as new com.sun.star.beans.PropertyValue
rem ----------------------------------------------------------------------
rem datei zeileweise einlesen und dir zeile zum hyperlink verarbeiten
n = FreeFile()
DateiNameHypListe = ""
DateiNameHypListe="C:\!tmp\hyperlinkliste.txt"
' msgbox DateiName
DateiNameHypListe =ConvertToURL(DateiNameHypListe)

Open DateiNameHypListe For Output Access Read As #n
While Not EOF(n)
Line Input #n, StrZeile
REM Inhalt von StrZeile ist wie folgt:
REM Hyperlink.text;zu Bild 1;Hyperlink.URL;#Bild1|graphic;Hyperlink.Target;1;Hyperlink.Name;zu Bild 1;Hyperlink.Type;1
REM zerlegen der Zeile in das Array StrZeile
StrTeile = Split(StrZeile, ";")
rem ----------------------------------------------------------------------
rem document = ThisComponent.CurrentController.Frame
rem dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
document = document1
dispatcher = dispatcher1
rem dim args1(4) as new com.sun.star.beans.PropertyValue
rem ----------------------------------------------------------------------
rem werte zuweisen
args1(0).Name = StrTeile(0) '"Hyperlink.Text"
args1(0).Value = StrTeile(1) '"#Bild3|graphic"
args1(1).Name = StrTeile(2) '"Hyperlink.URL"
args1(1).Value = StrTeile(3) '"#Bild3|graphic"
args1(2).Name = StrTeile(4) '"Hyperlink.Target"
args1(2).Value = StrTeile(5) ' ""
args1(3).Name = StrTeile(6) '"Hyperlink.Name"
args1(3).Value = StrTeile(7) ' "zu Bild 3"
args1(4).Name = StrTeile(8) '"Hyperlink.Type"
args1(4).Value = StrTeile(9) '1
'msgBox args1(0).value
dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, args1())
rem ----------------------------------------------------------------------
rem werte zuweisen
'dim args2(4) as new com.sun.star.beans.PropertyValue
args2(0).Name = StrTeile(0) ' "Hyperlink.Text"
args2(0).Value = StrTeile(1) ' "#Bild3|graphic"
args2(1).Name = StrTeile(2) '"Hyperlink.URL"
args2(1).Value = StrTeile(3) ' "#Bild3|graphic"
args2(2).Name = StrTeile(4) ' "Hyperlink.Target"
args2(2).Value = StrTeile(5) ' ""
args2(3).Name = StrTeile(6) '"Hyperlink.Name"
args2(3).Value = StrTeile(7) '"zu Bild 3"
args2(4).Name = StrTeile(8) '"Hyperlink.Type"
args2(4).Value = StrTeile(9) '1

dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, args2())
rem ----------------------------------------------------------------------
'dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "Count"
args3(0).Value = 1
args3(1).Name = "Select"
args3(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args3())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array())

Wend
rem ----------------------------------------------------------------------
rem hier ende der datei erreicht
Close #n
end Sub

Das war eine Textdatei insertHyperlink_zuB.txt konnte ich nicht Anhängen.
Hyperlinks sind dann nicht im LibreOffice-Dokument drinn, ich verwende Version 4.4.5.2 unter Windows 7 64-Bit.
Kann mir bitte jemand einen Tipp geben warum es nicht funktioniert.

Gruß Roland "chemnitzer"

[lorbass]

Zur übersichtlichen Darstellung von Programmcode im Text stehen die [​code][/code] Tags zur Verfügung.

Gruß
lorbass

[chemnitzer]

Hallo
danke für den Tipp, habs getestet sieht gleich viel besser aus.

Gruss Roland "Chemnitzer"

[chemnitzer]

Hallo
ich bin mittlerweile weiter gekommen. Es funktioniert auch, aber bei hoher Verknüpfungen bricht das Programm ab wenn ich die Datei Speichern oder als PDF exportieren will.
Die Textdatei hat ca. 150 Zeilen mit verschiedenen Bildern, diese werden als Verknüpfung erfolgreich eingefügt. Speichern und Export bricht aber ab - über das normale Menü.
Kann mir bitte jemand helfen ?

MfG
Chemnitzer

Hier noch der Code:

Code: Alles auswählen

Sub insMasterfromFile

 Dim n As Integer            'filenummer
 Dim DateiName As String     'txt-quelldatei 
 Dim StrZeile As String      ' eingelesene Zeile
 Dim FileStrZeile As String  ' eingelesene Zeile
 Dim iZeile As Integer
 	n = FreeFile()
 	iZeile =0
	DateiName = ""

	DateiName = "C:\!tmp\test.txt"  'muss angepasst werden
'--------------------------------------------------------------
'Aufbau von test.txt z.B.:
'F:\USB-blau\Bilder\IMG_3791.JPG
'Y:\Seite010.jpg
'
'--------------------------------------------------------------
	DateiName =ConvertToURL(DateiName)
	
    Open DateiName For Output Access Read As #n  ' txt-datei zum lesen öffnen

    While Not EOF(n)
		Line Input #n, StrZeile   ' zeile einlesen
		iZeile=iZeile +1
        FileStrZeile =ConvertToURL(StrZeile)        

        If FileExists(StrZeile)=False Then
        	msgbox "Bilddatei nicht existent : " & StrZeile 
        else  
		Call Insert_Bitmap07 (FileStrZeile,iZeile)
	End if
	Wend
	Close #n	
    msgbox "alle Bilder eingefügt"
End Sub

Sub Insert_Bitmap07 ( sname As String, i As integer)
	Dim sURLs As String
	Dim fakvert,fakhor,  ho,  hori As Long ', kon As String
	Dim oSize as new com.sun.star.awt.Size
	Dim relgrafik As Double, relseite As Double ', seite As Long
	Dim va(20), za As Long, zb As Long, zh As Long, zc As Long, zd,ze As Long, v As Object
	Dim Page_L,Page_R,Page_O,Page_U As Long
	Dim M As double,Mh As double,Mb As double
'=============================================================================================	 
 
    oDoc = thisComponent
    sUrls(0) = sname
    oText = odoc.Text
    oTextcursor = oText.createTextCursor
    oTextcursor.collapseToStart
    oTextCursor.gotoend(false)
    ssname = "MeinBild"+i'interner Name des Bildes
        
' aus Textquik 
	ho=0 
	oViewcursor = oDoc.CurrentController.getViewcursor()
	v = oViewCursor.getPosition()
	hori = v.X      
	oGraphic = ThisComponent.createInstance("com.sun.star.text.GraphicObject")
	oGraphic.GraphicURL = sname  'doc
	oGraphic.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER  
	oGraphic.HoriOrient = ho
	If ho = 0 Then oGraphic.HoriOrientPosition = hori
	oText.insertTextContent( oViewCursor, oGraphic, False )
	Wait (400) 
 	
	oSize = oGraphic.getSize
 	zb = oSize.Width	'grafikbreite
	zh = oSize.Height 	'grafikhoehe 
	relgrafik = zh/zb       'grafikseitenverhältnis
	
	oStyle = oDoc.styleFamilies.getByName("PageStyles").getByName("Standard")
'	Xray oStyle
	Page_L = oStyle.LeftMargin	'linker seitenrand
	Page_R = oStyle.RightMargin	'rechter seitenrand
	Page_O = oStyle.TopMargin	'oberer seitenrand
	Page_U = oStyle.BottomMargin	'unterer seitenrand
		zd = oStyle.Width - oStyle.RightMargin  - oStyle.LeftMargin  ' A4 nutzbarebreite
		ze = oStyle.Height - oStyle.BottomMargin  - oStyle.TopMargin  ' A4 nutzbarehoehe
		relseite = ze/zb                                      ' A4 seitenverhältnis
        Mh = ze/zh
        Mb = zd/zb
        M = 1
        If (zb > zd) Or (zh>ze) then
	        If Mh<Mb Then
    	      M = Mh
        	Else
	          M = Mb
    	    end if    
    	Else
    	  If Mh<Mb Then
    	    M = Mh
    	  Else
    	    M = Mb
    	  End if
    	End if    
	zb = zb * M
	zh = zh * M
		
 	If zb > 0 Then
		oGraphic.Height = zh
		oGraphic.Width = zb
		oText.insertTextContent( oViewCursor, oGraphic, False )		
	End if		
       'Text einfügen
        oTextCursor.gotoend(false)
        oTextCursor.breaktype = 0
        oText.insertControlCharacter(oTextCursor,0 , False)'0 = com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK
end Sub

[mikele]

Hallo,

aber bei hoher Verknüpfungen bricht das Programm ab wenn ich die Datei Speichern oder als PDF exportieren will.

Bei hoher Anzahl von Verknüpfungen? Hast du mal ausprobiert, bei wie vielen Einträgen es funktioniert? Liegt es ggf. an einem einzelnen Eintrag? Wie groß sind die Bilddateien?

Grundsätzlich kann ich erstmal nur bestätigen, dass das Makro funktioniert und macht, was es soll (probiert mit 3-zeiliger txt-Datei).

[chemnitzer]

Hallo
erstmal Danke für die Antwort. Ich hatte danach noch Version 5 installiert, das gleiche Problem. Version 5 deinstalliert. APP-Verzeichnis umbenannt, aber vorher meine Makros als TEXTDATEI zwischen gespeichert. Jetzt aktuelle Version 4.5 installiert. Nach neuen Programmstart gibt es ein neues APP-Verzeichnis, jetzt Makros wieder rein kopiert und es funktioniert. War wohl was in der APP-Struktur defekt.
Waren 100 Bilder mit ca. 3,5 MB groß´. Stürzte aber schon mal bei 50 auch ab. PDF Export ging vorher auch nicht. Jetzt gehts.
Bin noch dran einInhaltsverzeichnis mit Links zu den Seiten über den Bildname zuerstellen.
z.´B.: Mürbeteig 222 , wobe auf die "222" einHyperlink liegen soll z.B. nach "Bild222", welches dann der Inhalt des Kapitels ist.
Im Export nach PDF soll dann der Link mitgenommen werden.
Viele Grüße