[GELÖST] Weitere Hyperlinks in Zelle einfügen

Programmierung unter AOO/LO (StarBasic, Python, Java, ...)

Moderator: Moderatoren

Ralf R
*
Beiträge: 16
Registriert: Di, 20.10.2020 17:13

[GELÖST] Weitere Hyperlinks in Zelle einfügen

Beitrag von Ralf R »

Hallo, Ihr Lieben!

Mit meinem Makro will ich Hyperlinks in Zellen einfügen, in denen sich schon welche befinden. Die einzufügenden Hyperlinks sind in einer zweiten Tabelle aufgelistet, werden von dort aus nach der Auswahl übertragen und ersetzen damit die passende Textstelle. Der Haken an der Sache ist, dass ich mit der Routine Instr() nicht die richtige Stelle im Text der Zelle bekomme und nach der Formel < exakter Wert = ermittelter Wert - Gesamtzahl der in den Hyperlinks davor verwendeten Zeichen + Anzahl dieser Hyperlinks > nachkorrigieren muss.

Beispiel (zum Demonstrationszweck leicht verändert):
in der Zelle befindet sich folgender Text:

irregular cells around the base of an intercalary branch (Fig. 3:27-29): lobes around the base of a Lejeunea-type branch (Figs 29, 310:31): an extension of the foot around the base of the seta (Figs 131, 213).

Mit einem anderen Makro ist schon der Hyperlink bei “3” eingefügt. Als nächstes ist die “29” dran.
Damit sich der Hyperlink nicht vorschnell (also in der ersten Klammer) einklinkt, lass ich den Cursor mithilfe der Informationen, die ich über Position und Zeichenkettenlänge erhalten habe [rem A], etwas vorlaufen [rem B]. Zurücksetzen muss ich hier noch nicht. Bei der “310 “ geht es getreu der obigen Formel ein Zeichen zurück [rem C], bei der “131” drei und bei der ”213” fünf Zeichen.

Code: Alles auswählen

Sub HyperlinkMehrereSpaeterA

osheet = ThisComponent.CurrentController.ActiveSheet
osheet = thisComponent.sheets.getByName(osheet.name)
h = ThisComponent.CurrentController.ActiveSheet.RangeAddress.Sheet

On Error GoTo ErrorHandler

namsh = "Abbildungen"

osheet_1 = thisComponent.sheets.getByName(namsh)

    oCellCursor = oSheet_1.createCursor
    oCellCursor.GotoEndOfUsedArea(False)
    nRow = oCellCursor.getRangeAddress().endRow
   
    nCol = oCellCursor.getRangeAddress().endColumn
   
    
num = InputBox("Bitte geben Sie die Zeichefolge ein, die durch einen Hyperlink ersetzt werden soll!",, )  
 

oCellRange = osheet_1.getCellRangeByPosition(0,0,nCol,nRow)

iErsteSpalte = oCellRange.rangeAddress.startColumn
iErsteZeile = oCellRange.rangeAddress.startRow
iLetzteSpalte = oCellRange.rangeAddress.EndColumn
iLetzteZeile = oCellRange.rangeAddress.EndRow

For i = iErsteZeile to iLetzteZeile
For m = iErsteSpalte to iLetzteSpalte
oCell_2 = osheet_1.getCellByPosition(m,i)


oParEnum = oCell_2.getText().createEnumeration()
Do While oParEnum.hasMoreElements()
oParElement = oParEnum.nextElement()

oEnum = oParElement.createEnumeration()
Do While oEnum.hasMoreElements()
oElement = oEnum.nextElement()

If oElement.TextPortionType = "TextField" Then
If oElement.TextField.supportsService("com.sun.star.text.TextField.URL") Then

HypAdr = oElement.TextField.URL
HypNam = oElement.TextField.Representation

If HypNam = num Then
GoTo Weiter
EndIf

End If
End If
Loop
Loop
Next m
Next i

Weiter:

ThisComponent.currentController.select( oCell_1 )
oCell_1 = ThisComponent.getCurrentSelection().getCellAddress()
ca = oCell_1.Column
ra = oCell_1.Row
oCell_1 = osheet.getCellByPosition(ca,ra)



  With ThisComponent.Sheets().getByIndex(h)
    x = .Columns(ca).queryEmptyCells() 
    fow = x(x.Count-1).RangeAddress.StartRow - 1
  End With

C_1str = oCell_1.string

g = Len(C_1str)
k = InStr(C_1str, num)

rem A:
msgbox "Zuerst tritt die Zeichenfolge etwa an Position " & k & " auf." & chr(13) & "Die Zelle enthält ca. " & g & " Zeichen."

rem B: 
Dim f%
f = InputBox("Bitte geben Sie an, ab dem wievielten Zeichen gesucht werden soll soll!",, )

If f = 0 Then
f = 1
EndIf


c = InStr(f, C_1str, num)

msgbox "c: " & c

d = Len(num) 

rem C:
Dim e%
e = InputBox("Bitte geben Sie an, um wieviele Zeichen der Cursor zurücksetzen soll!",, )

oTextCursor = oCell_1.createTextCursor

oTextCursor.goToStart( false )
oTextCursor.goRight(c-1-e,false) rem --- Formel zur Bestimmung der exakten Position
oTextCursor.goRight(d,true)

oField = ThisComponent.createInstance("com.sun.star.text.TextField.URL")
oField.Representation = HypNam
oField.URL = ConvertToURL(HypAdr)

oCell_1.insertTextContent( oTextCursor,oField, True )


Exit Sub

ErrorHandler: 
msgbox "Fehler in Zeile "  & Erl

End Sub
Mir wär’s ganz lieb, wenn das Makro das selbständig ausrechnen würde, aber mir fehlen an dieser Stelle die passenden Befehle, um die Länge der Hyperlinks zu berücksichtigen.

Hat jemand eine Idee?

(Seitenfrage: manchmal kommt es vor, dass bei bestimmter Schrift- und Zellengröße die Zeigerhand nicht an der Stelle erscheint, wo der Hyperlink zu sehen ist, sonder rechts daneben oder unterhalb (automatischer Zeilenumbruch ist aktiviert). Lässt sich das abstellen, oder muss ich damit leben)?

Viele Grüße,
Ralf
Zuletzt geändert von Ralf R am Mo, 18.04.2022 13:31, insgesamt 1-mal geändert.
mikeleb
*******
Beiträge: 1315
Registriert: Fr, 09.12.2011 16:50

Re: Weitere Hyperlinks in Zelle einfügen

Beitrag von mikeleb »

Hallo,
Der Haken an der Sache ist, dass ich mit der Routine Instr() nicht die richtige Stelle im Text der Zelle bekomme
Das verstehe ich nicht. Wenn ich dein Textbeispiel (inkl. Hyperlink)
irregular cells around the base of an intercalary branch (Fig. 3:27-29): lobes around the base of a Lejeunea-type branch (Figs 29, 310:31): an extension of the foot around the base of the seta (Figs 131, 213).
in Zelle A1 habe, dann liefert mir

Code: Alles auswählen

oCell_2=thiscomponent.sheets(0).getcellbyposition(0,0)
n=instr(sTmp,"Figs 29")
den korrekten Wert 123???
Instr() liefert bei mir nicht etwa die Position, sondern die exakte Position, genauso wie Len() die exakte Länge des Strings liefert.
Der in dem (Teil-)String enthaltene Hyperlink beeinflusst die Länge des Strings nicht.
Gruß,
mikeleb
Ralf R
*
Beiträge: 16
Registriert: Di, 20.10.2020 17:13

Re: Weitere Hyperlinks in Zelle einfügen

Beitrag von Ralf R »

Hallo mikeleb,

Du hast recht, ob Hyperlinks vorhanden sind oder nicht: mit Instr() bekommt man den gleichen Wert.

Ich wandel das Beispiel etwas ab:

Ich habe in den Zellen A1 un A2 den gleichen Text, nur dass in A1 anders als in A2 an 29 und 310 Hyperlinks gesetzt sind.

Code: Alles auswählen

Sub Beispiel

oCell_2=thiscomponent.sheets(0).getcellbyposition(0,0)
sTmp = oCell_2.string

oCell_3=thiscomponent.sheets(0).getcellbyposition(0,1)
sTmp1 = oCell_3.string

n = instr(sTmp,"131")
o = instr(sTmp1,"131")
msgbox "Position von 131 in A1 an " & n & ", in A2 an " & o

oTextCursor_2 = oCell_2.createTextCursor
oTextCursor_2.goToStart( false )
oTextCursor_2.goRight(n-1,false)
oCell_2.insertString( oTextCursor_2,"@", True )

oTextCursor_3 = oCell_3.createTextCursor
oTextCursor_3.goToStart( false )
oTextCursor_3.goRight(o-1,false)
oCell_3.insertString( oTextCursor_3,"@", True )

End Sub
Wenn ich jetzt obiges Makro ausführe, wird das “@”, obwohl ich den Textcursor in beiden Fällen gleich weit laufen lasse, an unterschiedlichen Stellen eingefügt.

Das erstaunliche Ergebnis sieht dann also so aus:


Screenshot (285).png
Screenshot (285).png (24.16 KiB) 1950 mal betrachtet

Gruß,
Ralf
mikeleb
*******
Beiträge: 1315
Registriert: Fr, 09.12.2011 16:50

Re: Weitere Hyperlinks in Zelle einfügen

Beitrag von mikeleb »

Hallo,
nun wird das Problem klar (und bei nur einem Zeichen mit Hyperlink nicht erkennbar): für den Textcursor ist ein Hyperlink nur ein Zeichen (egal wie lang der Repräsentationsstring ist).
Gruß,
mikeleb
Ralf R
*
Beiträge: 16
Registriert: Di, 20.10.2020 17:13

Re: Weitere Hyperlinks in Zelle einfügen

Beitrag von Ralf R »

Hallo mikeleb,
für den Textcursor ist ein Hyperlink nur ein Zeichen (egal wie lang der Repräsentationsstring ist).
hier irrst Du Dich leider. Der Textcursor zählt die Zeichen der Repräsentationsstrings mit, zieht davon jedoch eines für jeden Hyperlink ab. Meine Frage ist, ob es eine Möglichkeit gibt, dass das Makro in der Befehlszeile

Code: Alles auswählen

oTextCursor.goRight(c-1-e,false)
den Wert für “e” selbst findet, ohne dass ich mit der Inputbox arbeiten muss.


Gruß,
Ralf
mikeleb
*******
Beiträge: 1315
Registriert: Fr, 09.12.2011 16:50

Re: Weitere Hyperlinks in Zelle einfügen

Beitrag von mikeleb »

Hallo,
folgender Code ersetzt in der Zelle A2 jedes Vorkommen des Strings "131" durch einen Hyperlink.

Code: Alles auswählen

Sub Beispiel

oCell=thiscomponent.sheets(0).getcellbyposition(0,1)
oTextCursor =ocell.createTextCursor
'zu ersetzender Strimg
sNum="131"

'Zelltext in Paragrapghen zerlegen
oParEnum = oCell.getText().createEnumeration()
'Durchlauf durch alle Paragraphen
Do While oParEnum.hasMoreElements()
	'Paragraph in Einzelteile zerlegen
	oParElement = oParEnum.nextElement()
	oEnum = oParElement.createEnumeration()
	'Durchlauf durch alle Paragraphen
	Do While oEnum.hasMoreElements()
		oElement = oEnum.nextElement()
		
		If oElement.TextPortionType = "Text" and instr(oelement.string,sNUm)>0 Then	'nur Textteile mit dem Suchtext bearbeiten
			'Zerlegen des Textteils - Trennung nach jedem Auftreten des Suchtextes
			aTmp=split(oelement.string,sNUm)
			'Textcursor auf das Textelement ausdehnen
			oTextCursor.gotorange(oelement.getstart,false)
			oTextCursor.gotorange(oelement.getend,true)

			for i=0 to ubound(aTmp)
				'Überschreiben mit dem ursprünglichen Text
				ocell.insertString( oTextCursor,atmp(i),true)
				oTextCursor.goright(len(atmp(i)),false)
				if i<ubound(aTmp) then
					oField = ThisComponent.createInstance("com.sun.star.text.TextField.URL")
					oField.Representation = sNum
					oField.URL = ConvertToURL("www.google.de/"&snum)
					'Überschreiben/Einfügen Hyperlink
					oCell.insertTextContent( oTextCursor,oField, True)
					oTextCursor.goright(1,false)
				end if

			next	

		end if
	loop
loop


End Sub
Gruß,
mikeleb
Ralf R
*
Beiträge: 16
Registriert: Di, 20.10.2020 17:13

Re: Weitere Hyperlinks in Zelle einfügen

Beitrag von Ralf R »

Hallo mikeleb,

sei (in zweifacher Hinsicht) herzlich bedankt für Deinen Code, der ja eine überaus nützliche Erweiterung des Listings 480 bei Andrew Pitonyak darstellt.
Erstens kann ich jetzt für die gewählte Zeichenkette alle Vorkommen in einer Zelle gleichzeitig mit einem Hyperlink ersetzen. Das geht auch bei nachfolgenden anderen Strings, nicht jedoch wenn sich dahinter schon ein Hyperlink befindet. Dann bin ich wieder auf mein Makro mit der oben genannten Formel angewiesen.
Zweitens bin ich durch Deinen Post auf eine Idee gekommen, wie ich dieses verflixte “e” herauskriege.

Code: Alles auswählen

e = 0

Rem --- oCell_4 dient als "Hilfszelle".

oCell_4 = osheet.getCellByPosition(a+2, b)

pos = instr(oCell_3.string,num)

oZellbereichsAdresse.Sheet = h
oZellbereichsAdresse.StartColumn = a
oZellbereichsAdresse.StartRow = b
oZellbereichsAdresse.EndColumn = a
oZellbereichsAdresse.EndRow = b

oZielZellAdresse.Sheet = h
oZielZellAdresse.Column = a+2
oZielZellAdresse.Row = b

oTabellenblatt = ThisComponent.Sheets(h)
oTabellenblatt.copyRange( oZielZellAdresse, oZellbereichsAdresse )


oTextCursor = oCell_4.createTextCursor

Rem --- Nachdem der Inhalt der zub bearbeitenden Zelle samt Hyperlinks
Rem --- in die Hilfszelle kopiert wurde, wird jetzt der Teil abgeschnitten,
Rem --- der hinter dem zu ersetzenden String liegt.

oTextCursor.goToStart( false )
oTextCursor.goRight(pos,false)
oTextCursor.goToEnd(true)
oCell_4.insertstring( oTextCursor,"", True )

Rem --- Anschließend erfolgt die Auswertung.

oParEnum = oCell_4.getText().createEnumeration()
Do While oParEnum.hasMoreElements()
oParElement = oParEnum.nextElement()
oEnum = oParElement.createEnumeration()
Do While oEnum.hasMoreElements()
oElement = oEnum.nextElement()
If oElement.TextPortionType = "TextField" Then
If oElement.TextField.supportsService("com.sun.star.text.TextField.URL") Then

t = len(oElement.TextField.Representation)

u = t-1
e = e+u
End If
End If
Loop
Loop

Beide Makros in eins gepackt, Schleifchen um den Zellbereich, und ein Großteil der Hyperlinks für diese Zeichenkette wird in einem Rutsch eingefügt.
Das ist mehr, als ich erwartet habe!

Viele Grüße,
Ralf
Antworten