inhaltsverzeichnis

[paulpanther]

hallo gruppe,

kennt jemand den basic-code, der ein inhaltsverzeichnis der vorhandenen sheets erstellt?

lass mich überraschen.

grüße

paul

[kannenklaus]

hallo paulpanther,

inhaltsverzeichnis der vorhandenen sheets erstellt?

probier´s mal damit:

Code: Alles auswählen

Sub Inhaltsverzeichnis
	Dim calcDoc as Object 
	Dim oBlattInhalt as Object, oZelleHyp as Object, oZelleUeberschrift as Object
	Dim oField as Object, oText as Object
	dim oView as Object 'Ansicht
	Dim strInh, strBlattName as String
	Dim i as Integer
	calcDoc = ThisComponent
	strInh = "Inhaltsverzeichnis"

	'--Falls das Blatt Inhaltsverzeichnis vorhanden ist, löschen ansonsten anlegen
	If calcDoc.Sheets.hasByName(strInh) = true Then
		MsgBox ("Das Blatt """+strInh+""" ist vorhanden"+chr(13)+ _
		"und wird gelöscht und dann neu angelegt.",0,"B+P-->Info")
		calcDoc.Sheets.RemoveByName(strInh)
	End If
	calcDoc.Sheets.InsertNewByName(strInh,0)
	oBlattInhalt = calcDoc.sheets.getByName(strInh)	
	
	'--for/next-Schleife für das Inhaltsverzeichnis
	for i = 1 to calcDoc.sheets.count-1
		'--Textfeld für Hyperlink erzeugen
		oField = ThisComponent.createInstance("com.sun.star.text.TextField.URL")'URL Textfeld erzeugen
		oField.Representation =calcDoc.sheets(i).name 'Text, der im Hyperlink erscheint 
		oField.URL = ConvertToURL("#"+calcDoc.sheets(i).name+".A1")'erstellt den Hyperlink
		
		'--Erzeugt den Hyperlink
		oZelleHyp = oBlattInhalt.getCellByPosition(0,i)'Zielzelle des Hyperlink
		oText = oZelleHyp.getText()
		oText.insertTextContent(oText.createTextCursor(), oField, False)
	next
	
	'Überschrift erstellen
	oZelleUeberschrift=oBlattInhalt.getCellByPosition(0,0)
	with oZelleUeberschrift
		.setstring("Inhaltsverzeichnis")
		.isTextWrapped = False
		.CharWeight = com.sun.star.awt.FontWeight.BOLD
		.CharHeight = 12
	end with

'--zum Inhaltsverzeichnis wechseln	
	oView=calcDoc.CurrentController
	oView.setActiveSheet(oBlattInhalt)
	oView.freezeAtPosition(0,1)
	oView.setFirstVisibleRow(1)
	oView.select(oZelleUeberschrift)

End Sub

grüße

klaus

[paulpanther]

Hallo Klaus,

besten Dank für Deinen Code; der läuft supi. Genau das habe ich gesucht.

Grüße

Paul