OpenOffice.info

Hallo Klaus,

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

Grüße

Paul

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

hallo paulpanther,

[quote] inhaltsverzeichnis der vorhandenen sheets erstellt?[/quote]

probier´s mal damit:

[code]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[/code]

grüße

klaus

hallo gruppe,

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

lass mich überraschen.

grüße

paul