Ano to je jiné "kafe". Pomocí makra rozebereme hyperlinky do tvaru:
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#Dejiny
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#Miestne_časti
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#Malé_Bierovce
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#Kochanovce
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#Adamovce
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#Stavebné_pamiatky
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#Národnostné_zloženie
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#Významné_osobnosti
https://sk.wikipedia.org/wiki/Adamovské_Kochanovce#Referencie
Makro které to umí rozebrat:
Sub ShowAllHyperlinks()
Dim oDocument as object
Dim oSheet as Object
Dim oCellCursor as object
Dim intLastRow as integer
Dim intLastCol as integer
Dim oNewSheet as object
Dim intCurRow as integer
Dim intCurCol as integer
Dim intNewRow as integer
Dim oNewCell as object
dim strURLList() as string
Dim oCell as Object
Dim strNewSheet as String
' Get access to the document
oDocument = ThisComponent
' Get New Sheet Name From User
strNewSheet = inputBox ("zadejte název pro nov7 list, který zobrazí seznam všech URLs")
' Find Last Cell of Data in Sheet
oSheet = oDocument.getCurrentSelection.getSpreadSheet
oCellCursor = oSheet.createCursor()
oCellCursor.gotoEndOfUsedArea(False)
intLastRow = oCellCursor.getRangeAddress().endRow
intLastCol = oCellCursor.getRangeAddress().endColumn
intNewRow = 0
' Loop Through all Cells looking for URLs
For intCurRow = 0 to intLastRow
For intCurCol = 0 to intLastCol
oCell = oSheet.getCellByPosition(intCurCol, intCurRow)
' VarType 9 = Object
If vartype(oCell) = 9 then
' If Count is greater than 1, we have a cell with a URL
If oCell.TextFields.Count > 0 Then
Redim Preserve strURLList(intNewRow)
' Grab the URL and store it in an array
strURLList(intNewRow) = oCell.GetTextFields.getByIndex(0).URL
intNewRow = intNewRow + 1
End If
End If
Next
Next
' Create the new Sheet
oSheet = ThisComponent.createInstance("com.sun.star.sheet.Spreadsheet")
oDocument.Sheets.insertByName(strNewSheet, oSheet)
' Loop Through Array and put the URLs on the new Sheet
For intCurRow = 0 to intNewRow - 1
oCell = oSheet.getCellByPosition(0, intCurRow)
oCell.String = strURLList(intCurRow)
Next
msgbox "URL kompletně extrahovány"
End Sub
Zde se nabízí několik postupů. Ukázka obsahuje i název, ale můžeme ho kompletně použít jako URL a buď použít vzorce "hyperlink", nebo vložit do buňky vedle nový název, načíst URL a přes název vložit Hypertext.
Rozebrat původní hypertexty můžeme udělat naráz: vybrat všechny a spustit makro. V novém listu máme naráz všechny, ale přestavět musíme jednotlivě, nebo makrem (to jsem testoval před mnoha lety, takže neručím za výsledek). Pokud byste si neporadil, musíte mi poslat ukázku a já to doladím. Jde o to jak nastavit různé názvy pomocí vzorců. Domnívám se, že Vaše poznámka (TN) znamená okres Trnečín, ale problematik může být víc - například získat část názvu z URL vytvořeného makrem ap. Zde je makro které by mělo umět hromadně vytvořit nové hypertexty:
Sub Cyklus
' n = počet řádků s odkazy počínaje řádkem 0 do n-tého (-1)
For i = 0 To n
ReplaceByHyperlink
Next i
End Sub
sub ReplaceByHyperlink 'udělá ze zadaného textu hyperlink - i v Calcu
dim document as object
dim dispatcher as object
dim oSelection, oRange as object
dim strSelectedWord as String
oSelection = ThisComponent.CurrentController.Selection
oRange = oSelection(0)
If Not (HasUnoInterfaces(oRange, "com.sun.star.text.XTextRange")) Then
MsgBox "Text není přístupný"
exit sub
End if
strSelectedWord = oRange.getString
If Len(strSelectedWord) < 1 Then
MsgBox "Text není vybrán"
exit sub
End if
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(4) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Hyperlink.Text"
args1(0).Value = strSelectedWord 'zadat buňku s názvem hypertextu
args1(1).Name = "Hyperlink.URL"
args1(1).Value = "http://www." + LCase(strSelectedWord) + ".com/" 'Zadat buňku s url"
args1(2).Name = "Hyperlink.Target"
args1(2).Value = ""
args1(3).Name = "Hyperlink.Name"
args1(3).Value = strSelectedWord 'zadat buňku s názvem hypertextu
args1(4).Name = "Hyperlink.Type"
args1(4).Value = 1
dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, args1())
end sub
Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ
