von martin11 » Do, 08.08.2019 17:31
Von so was habe ich nicht die geringste Ahnung
Passiert ist das, weil ich diese Bas mit dem vorhin hochgeladenen ersetzt habe.
Es könnte auch sein, das der Pfad zu eiern Calc-Tabelle fehlt
Martin
--------------------------------------------------
Code: Alles auswählen
REM ***** BASIC *****
REM
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Die Haupt-/ Startroutine heisst: StartKopfzeile
REM Es wird ein Dialog mit Steuerlementen und einem Textfeld mit weiteren Informationen
REM zur Programmbenutzung per Code erzeugt.
REM
REM Einlesen der Kopfzeilen-Texte aus einer Calc-Tabelle. Die Texte MÜSSEN im Zellbereich B1:B20 stehen!
REM Seitenberechnungen von Seite 2 - nSeite (siehe const nSeite=240) gleich hier oben am Anfang des Programms.
REM Formatierung jeder ersten Zeile einer Seite per Absatzvorlage,
REM dabei Differenzierung zwischen linker und rechter Seite.
REM Eintragen der entsprechenden Texte, in Abhängigkeit der Seitenberechnung und Seite links/rechts
REM Rücksprung in die Hauptroutine
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Konstante für die zu bearbeitenden Seiten
Const nSeite=240
REM Deklaration der Varaiblen
Dim oDocW as Object ' Writer-Dokument
Dim oDocC as Object ' Calc-Dokument (wird versteckt geöffnet)
Dim oCC as Object ' CurrentController
Dim oVC as Object ' ViewCursor
Dim mArray1 ' Array für die Kopfzeilen-Texte (linke Seite)
DIm mArray2 ' Array für die Kopfzeilen-Texte (rechte Seite)
Dim sUrl ' URL-Pfad Calc-Datei
Dim bTrue as Boolean
REM Deklaration der Objektvariablen des Programmdialogs
Dim oDlg as Object
REM Start der Hauptroutine
Sub StartKopfzeile
Dim oDlgM as Object ' das Modell des Dialogs
Dim oMod as Object ' nimmt jeweils das Modell der Objekte auf
REM das Dialogmodell erzeugen
oDlgM = createUnoService("com.sun.star.awt.UnoControlDialogModel")
REM Eigenschaften zuweisen
With oDlgM
.setPropertyValue("PositionX", 100)
.setPropertyValue("PositionY", 100)
.setPropertyValue("Width", 350)
.setPropertyValue("Height", 195)
.setPropertyValue("BackgroundColor", RGB(255,255,255) 'Hintergrundfarbe
.setPropertyValue("Title", "Programm zur Bearbeitung der Pseudo-Kopfzeilen innhalb des Writer-Dokuments")
End With
REM Textlabel erzeugen
oMod = oDlgM.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
With oMod
.setPropertyValue("Name", "Text2")
.setPropertyValue("PositionX", 20)
.setPropertyValue("PositionY", 10)
.setPropertyValue("Width", 310)
.setPropertyValue("Height", 140)
.setPropertyValue("BackgroundColor", RGB(250,230,0) 'Hintergrundfarbe
.setPropertyValue("Border", 1)
.setPropertyValue("Label", chr(10) & " Die regulären Kopfzeilen sind in diesem Writer-Dokument, innerhalb der Seitenvorlagen absichtlich deaktiviert." & chr(10) & _
" Anstelle der regulären Kopfzeilen, wird auf jeder Seite per Makro die erste Zeile" & chr(10) & _
" mittels Absatzvorlagen formatiert und der jeweilige Text eingefügt." & chr(10) & chr(10) & _
" Das Makro erwartet eine Calc-Datei namens >>> Kopfzeilen_Texte.ods <<<" & chr(10) & _
" Jede andere Datei-Auswahl führt zu einem Fehler und zu einem Programmabbruch!" & chr(10) & chr(10) &_
" Die Datei >>> Kopfzeilen_Texte.ods <<< enthält die Texte für die Pseudokopfzeilen." & chr(10) & _
" Änderungen der Texte können nur in der Calc-Datei vorgenommen werden." & chr(10) & _
" Die Zeilen 1-10 enthalten die Texte für die linken Seiten des Dokuments." & chr(10) & _
" Die Zeilen 11-20 enthalten die Texte für die rechten Seiten des Dokuments." & chr(10) & _
" Mehr als zwanzig Einträge, werden vom Makro nicht berücksichtigt!"& chr(10) & chr(10) &_
" Wenn das Programm zur Bearbeitung der Writer-Datei gestartet werden soll," & chr(10) &_
" dann klicken Sie bitte auf den Button 'Start', ansonsten 'Abbruch'" & chr(10))
End With
oDlgM.insertByName("Text2", oMod)
REM Button erzeugen
oMod = oDlgM.createInstance("com.sun.star.awt.UnoControlButtonModel")
With oMod
.setPropertyValue("Name", "btn")
.setPropertyValue("PositionX", 260)
.setPropertyValue("PositionY", 160)
.setPropertyValue("Width", 65)
.setPropertyValue("Height", 20)
.setPropertyValue("Label", "Abbruch/ Beenden" )
End With
oDlgM.insertByName("btn", oMod)
REM den eben erzeugten Button klonen (vor der Anzeige des Dialogs)
oMod = oMod.CreateClone
With oMod
.Setpropertyvalue("PositionX",25)
.Setpropertyvalue("PositionY",160)
.Setpropertyvalue("Name","btnStart")
.SetpropertyValue("Label", "Start"
End With
oDlgM.insertByName("btnStart", oMod)
REM den eben erzeugten Button klonen (vor der Anzeige des Dialogs)
oMod2 = oMod.CreateClone
With oMod2
.Setpropertyvalue("PositionX",115)
.Setpropertyvalue("PositionY",160)
.setPropertyValue("Width", 120)
.Setpropertyvalue("Name","btnStart")
.SetpropertyValue("Label", "Texte der Pseudo-Kopfzeilen löschen"
End With
oDlgM.insertByName("btnDelete", oMod2)
REM Dialog ertellen
oDlg = CreateUnoService("com.sun.star.awt.UnoControlDialog")
oDlg.setModel(odlgM)
REM Listener für Abbruch-Button
oListenerClone = CreateUnoListener("btn_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btn")
oControl.addActionListener(oListenerClone)
REM Listener für den geklonten Button
oListenerClone = CreateUnoListener("btnStart_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btnStart")
oControl.addActionListener(oListenerClone)
REM Listener für den geklonten Button
oListenerClone2 = CreateUnoListener("btnDelete_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btnDelete")
oControl.addActionListener(oListenerClone2)
REM Dialog anzeigen
oWin = createUnoService("com.sun.star.awt.Toolkit")
oDlg.createPeer(oWin, null)
oDlg.execute
End Sub
'Aktion bei Klick auf 'Abbrechen'
Sub btn_actionPerformed(oEvent)
oDlg.EndExecute
End Sub
REM Aktion Pseudo-Kopfzeilen eintragen und formatieren
Sub btnStart_actionPerformed(oEvent)
'Listener für geklonten Button
oListenerClone = CreateUnoListener("btnStart_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btnStart" & cStr(iMax))
oControl.addActionListener(oListenerClone)
Dateidialog
End Sub
REM Aktion Pseudo-Kopfzeilen löschen
Sub btnDelete_actionPerformed(oEvent1)
oListenerClone2 = CreateUnoListener("btnDelete_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btnDelete" & cStr(iMax))
oControl.addActionListener(oListenerClone2)
'Dim nResult As Integer
' If bTrue=True then Exit Sub
' ' 1= OK 2 = Cancel
' nResult = MsgBox("Wollen Sie wirklich alle Texte in den Pseudo-Kopfzeilen löschen?", 305, "WARNUNG!")
'
' If nResult = 1 then
' Msgbox "Die Texte der Kopfzeilen werden gelöscht", 64, "Texte werden gelöscht!"
' bTrue=True
' Kopfzeileloeschen
' ElseIf nResult = 2 then
' Msgbox "Die Aktion wird abgebrochen!", 48, "Texte werden nicht gelöscht!"
' bTrue=True
' Exit Sub
' End If
Kopfzeileloeschen
End Sub
REM ???????????????????????? ENDE DIALOG-ROUTINE ??????????????????????????????????????????????????????????
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
Sub Dateidialog
On Error GoTo ErrorHandler
REM Laden der Bibliothek "Tools" mit den Hilfsfunktionen
GlobalScope.BasicLibraries.LoadLibrary( "Tools" )
MsgBox "Der nachfolgende Dateidialog fordert sie zum Öffnen dieser Datei auf:" & chr(10) & _
">>> Kopfzeilen_Texte.ods <<<" & chr(10) & _
"Wählen Sie zunächst den korrekten Pfad zu dieser Datei aus." ,64,"Hinweis"
' Filepicker (Datei-Dialog
ChooseAFileName
sExt=getFileNameExtension(sUrl)
' Fehlermeldung für den Fall, dass kein Calc-Dokument ausgewählt wurde
if sExt <> "ods" then
MsgBox("Bitte wählen Sie ein Calc-Dokument aus!" & chr(10) & _
"Das Programm wird beendet!" & chr(10) & chr(10) & _
"Starten Sie das Programm erneut.", 48, "Fehler: Dateiauswahl")
exit sub
end if
REM Calc-Datei im Hintergrund öffnen
Call FileOperation
REM Routine für die Pseudo-Kopfzeilen aufrufen
Call Seite
Exit Sub
REM ErrorHandler für den Fall, dass im Dateidialog auf "ABRUCH" geklickt wurde
ErrorHandler:
Msgbox "Sie haben den Dateidialog abgebrochen!" & chr(10) & _
"Starten Sie das Programm erneut und wählen eine Calc-Datei aus!", 48, "Fehler: Anwender hat Dateiauswahl abgebrochen!"
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Calc-Datei im Hintergrund öffnen
REM Dateioperation: Datei öffnen und auslesen
Sub FileOperation
n = FreeFile ' Immer nötig. Nächste freie Dateinumer
Open sUrl For Input As #n ' Datei zum Lesezugriff öffnen
Do While NOT EOF(n) ' Solange NOT End Of File
Input #n, s ' Daten werden gelesen
REM Hier werden die Daten verarbeitet
' Objekt-Eigenschaften
Dim FileProperties(1) As New com.sun.star.beans.PropertyValue
' Dokument im Hintergrund öffnen
FileProperties(0).Name = "Hidden"
FileProperties(0).Value = true
FileProperties(1).Name = "AsTemplate"
FileProperties(1).Value = true
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
' Datei öffnen
oDocC = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, FileProperties())
'mri oDocC
' Daten aus Tabelle einlesen und in die Arrays verteilen
' mArray1() = Daten für die linke Seite (gerade Seitenzahl)
mArray1()=oDocC.Sheets().getByName("KopfZeilenTexte").getCellRangeByName("A1:B10").getDataArray()
' mArray2() = Daten für die rechte Seite (ugerade Seitenzahl)
mArray2()=oDocC.Sheets().getByName("KopfZeilenTexte").getCellRangeByName("A11:B20").getDataArray()
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
' Datei nur einmal öffnen
x="true"
if x = "true" then exit do
Loop
' Calc-Datei korrekt schließen
CloseDocC
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Datei mit Filepicker öffnen
Function ChooseAFileName() As String
Dim vFileDialog ' Instanz des Service FilePicker
Dim vFileAccess ' Instanz des Service SimpleFileAccess
Dim iAccept as Integer ' Rückgabe vom FilePicker
Dim sInitPath as String ' Der Startpfad
' Achtung: Die folgenden Services müssen in dieser Reihenfolge
' aufgerufen werden, sonst wird Basic den vFileDialog nicht wieder entfernen.
vFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
vFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
' Jetzt wird der Startpfad gesetzt.
sInitPath = ConvertToUrl(CurDir)
If vFileAccess.Exists(sInitPath) Then
vFileDialog.SetDisplayDirectory(sInitPath)
End If
iAccept = vFileDialog.Execute() ' Der Dateiauswahldialog wird ausgeführt.
If iAccept = 1 Then ' Prüfung des Rückgabewerts des Dialogs.
ChooseAFileName = vFileDialog.Files(0) ' Rückgabe des Dateinamens, falls
' der Dialog nicht abgebrochen wurde.
sUrl = ChooseAFileName
End If
vFileDialog.Dispose() ' Der Dialog wird entfernt.
End Function
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Datei korrekt schließen
Sub CloseDocC
If HasUnoInterfaces(oDocC, "com.sun.star.util.XCloseable") Then
oDocC.close(true)
Else
oDocC.dispose()
End If
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
Sub Seite
'Dim oStar as Object
'Dim oDocW as Object
Dim oCC as Object
Dim oVC as Object
Dim oText as Object
Dim oEndCursor as Object
Dim oStartCursor as Object
Dim nDiv%
'mri oStar
oDocW=ThisComponent
oCC=oDocW.CurrentController
oVC = oCC.getViewCursor
oVC.jumpToPage(2)
'mri oVC
' Berechnung der erforderlichen Durchläufe
nDiv=nSeite/10 ' 10 = Anzahl der Arrayfelder
' Schleife über je 10 Arrayfelder
for i = 0 to 9
'
for j = 0 to nDiv
' gerade Seitenzahl = linke Seite
if oVC.Page mod 2 = 0 then
With oVC
.jumpToStartOfPage(False)
.ParaStyleName="_Gl_Text-8_pt_Kopf_Gerade_Rechts bündig"
.String=mArray1(i)(1)
' .BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
.collapseToEnd
.collapseToStart
.jumpToNextPage
End With
' ungerade Seitenzahl = rechte Seite
else
With oVC
.jumpToStartOfPage(False)
.ParaStyleName="_Gl_Text-8_pt Kopf_Ungerade_Links bündig"
.String=mArray2(i)(1)
' .BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
.collapseToEnd
.collapseToStart
.jumpToNextPage
End With
end if
next j
next i
MsgBox("Die Kopfzeileninhalte wurden ab Seite 2 bis zur Seite " & nSeite & " eingetragen!", 64, "Programmende: Kopfzeilen-Einträge")
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
Sub Kopfzeileloeschen
Dim oCC as Object
Dim oVC as Object
Dim oText as Object
Dim oEndCursor as Object
Dim oStartCursor as Object
Dim nDiv%
oDocW=ThisComponent
oCC=oDocW.CurrentController
oVC = oCC.getViewCursor
oVC.jumpToPage(2)
'mri oVC
' Berechnung der erforderlichen Durchläufe
nDiv=nSeite/10 ' 10 = Anzahl der Arrayfelder
' Schleife über je 10 Arrayfelder
for i = 0 to 9
for j = 0 to nDiv
' gerade Seitenzahl = linke Seite
if oVC.Page mod 2 = 0 then
With oVC
.jumpToStartOfPage(False)
.ParaStyleName="_Gl_Text-8_pt_Kopf_Gerade_Rechts bündig"
.gotoEndOfLine(true)
.String="" 'mArray1(i)(1)
' .BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
.collapseToEnd
.collapseToStart
.jumpToNextPage
End With
' ungerade Seitenzahl = rechte Seite
else
With oVC
.jumpToStartOfPage(False)
.ParaStyleName="_Gl_Text-8_pt Kopf_Ungerade_Links bündig"
.gotoEndOfLine(true)
.String="" 'mArray2(i)(1)
' .BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
.collapseToEnd
.collapseToStart
.jumpToNextPage
End With
end if
next j
next i
MsgBox("Die Kopfzeileninhalte wurden von Seite 2 bis " & nSeite & " gelöscht!", 15, "Programmende: Kopfzeilen-Löschung")
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
Von so was habe ich nicht die geringste Ahnung
Passiert ist das, weil ich diese Bas mit dem vorhin hochgeladenen ersetzt habe.
Es könnte auch sein, das der Pfad zu eiern Calc-Tabelle fehlt
Martin
--------------------------------------------------
[code]
REM ***** BASIC *****
REM
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Die Haupt-/ Startroutine heisst: StartKopfzeile
REM Es wird ein Dialog mit Steuerlementen und einem Textfeld mit weiteren Informationen
REM zur Programmbenutzung per Code erzeugt.
REM
REM Einlesen der Kopfzeilen-Texte aus einer Calc-Tabelle. Die Texte MÜSSEN im Zellbereich B1:B20 stehen!
REM Seitenberechnungen von Seite 2 - nSeite (siehe const nSeite=240) gleich hier oben am Anfang des Programms.
REM Formatierung jeder ersten Zeile einer Seite per Absatzvorlage,
REM dabei Differenzierung zwischen linker und rechter Seite.
REM Eintragen der entsprechenden Texte, in Abhängigkeit der Seitenberechnung und Seite links/rechts
REM Rücksprung in die Hauptroutine
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Konstante für die zu bearbeitenden Seiten
Const nSeite=240
REM Deklaration der Varaiblen
Dim oDocW as Object ' Writer-Dokument
Dim oDocC as Object ' Calc-Dokument (wird versteckt geöffnet)
Dim oCC as Object ' CurrentController
Dim oVC as Object ' ViewCursor
Dim mArray1 ' Array für die Kopfzeilen-Texte (linke Seite)
DIm mArray2 ' Array für die Kopfzeilen-Texte (rechte Seite)
Dim sUrl ' URL-Pfad Calc-Datei
Dim bTrue as Boolean
REM Deklaration der Objektvariablen des Programmdialogs
Dim oDlg as Object
REM Start der Hauptroutine
Sub StartKopfzeile
Dim oDlgM as Object ' das Modell des Dialogs
Dim oMod as Object ' nimmt jeweils das Modell der Objekte auf
REM das Dialogmodell erzeugen
oDlgM = createUnoService("com.sun.star.awt.UnoControlDialogModel")
REM Eigenschaften zuweisen
With oDlgM
.setPropertyValue("PositionX", 100)
.setPropertyValue("PositionY", 100)
.setPropertyValue("Width", 350)
.setPropertyValue("Height", 195)
.setPropertyValue("BackgroundColor", RGB(255,255,255) 'Hintergrundfarbe
.setPropertyValue("Title", "Programm zur Bearbeitung der Pseudo-Kopfzeilen innhalb des Writer-Dokuments")
End With
REM Textlabel erzeugen
oMod = oDlgM.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
With oMod
.setPropertyValue("Name", "Text2")
.setPropertyValue("PositionX", 20)
.setPropertyValue("PositionY", 10)
.setPropertyValue("Width", 310)
.setPropertyValue("Height", 140)
.setPropertyValue("BackgroundColor", RGB(250,230,0) 'Hintergrundfarbe
.setPropertyValue("Border", 1)
.setPropertyValue("Label", chr(10) & " Die regulären Kopfzeilen sind in diesem Writer-Dokument, innerhalb der Seitenvorlagen absichtlich deaktiviert." & chr(10) & _
" Anstelle der regulären Kopfzeilen, wird auf jeder Seite per Makro die erste Zeile" & chr(10) & _
" mittels Absatzvorlagen formatiert und der jeweilige Text eingefügt." & chr(10) & chr(10) & _
" Das Makro erwartet eine Calc-Datei namens >>> Kopfzeilen_Texte.ods <<<" & chr(10) & _
" Jede andere Datei-Auswahl führt zu einem Fehler und zu einem Programmabbruch!" & chr(10) & chr(10) &_
" Die Datei >>> Kopfzeilen_Texte.ods <<< enthält die Texte für die Pseudokopfzeilen." & chr(10) & _
" Änderungen der Texte können nur in der Calc-Datei vorgenommen werden." & chr(10) & _
" Die Zeilen 1-10 enthalten die Texte für die linken Seiten des Dokuments." & chr(10) & _
" Die Zeilen 11-20 enthalten die Texte für die rechten Seiten des Dokuments." & chr(10) & _
" Mehr als zwanzig Einträge, werden vom Makro nicht berücksichtigt!"& chr(10) & chr(10) &_
" Wenn das Programm zur Bearbeitung der Writer-Datei gestartet werden soll," & chr(10) &_
" dann klicken Sie bitte auf den Button 'Start', ansonsten 'Abbruch'" & chr(10))
End With
oDlgM.insertByName("Text2", oMod)
REM Button erzeugen
oMod = oDlgM.createInstance("com.sun.star.awt.UnoControlButtonModel")
With oMod
.setPropertyValue("Name", "btn")
.setPropertyValue("PositionX", 260)
.setPropertyValue("PositionY", 160)
.setPropertyValue("Width", 65)
.setPropertyValue("Height", 20)
.setPropertyValue("Label", "Abbruch/ Beenden" )
End With
oDlgM.insertByName("btn", oMod)
REM den eben erzeugten Button klonen (vor der Anzeige des Dialogs)
oMod = oMod.CreateClone
With oMod
.Setpropertyvalue("PositionX",25)
.Setpropertyvalue("PositionY",160)
.Setpropertyvalue("Name","btnStart")
.SetpropertyValue("Label", "Start"
End With
oDlgM.insertByName("btnStart", oMod)
REM den eben erzeugten Button klonen (vor der Anzeige des Dialogs)
oMod2 = oMod.CreateClone
With oMod2
.Setpropertyvalue("PositionX",115)
.Setpropertyvalue("PositionY",160)
.setPropertyValue("Width", 120)
.Setpropertyvalue("Name","btnStart")
.SetpropertyValue("Label", "Texte der Pseudo-Kopfzeilen löschen"
End With
oDlgM.insertByName("btnDelete", oMod2)
REM Dialog ertellen
oDlg = CreateUnoService("com.sun.star.awt.UnoControlDialog")
oDlg.setModel(odlgM)
REM Listener für Abbruch-Button
oListenerClone = CreateUnoListener("btn_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btn")
oControl.addActionListener(oListenerClone)
REM Listener für den geklonten Button
oListenerClone = CreateUnoListener("btnStart_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btnStart")
oControl.addActionListener(oListenerClone)
REM Listener für den geklonten Button
oListenerClone2 = CreateUnoListener("btnDelete_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btnDelete")
oControl.addActionListener(oListenerClone2)
REM Dialog anzeigen
oWin = createUnoService("com.sun.star.awt.Toolkit")
oDlg.createPeer(oWin, null)
oDlg.execute
End Sub
'Aktion bei Klick auf 'Abbrechen'
Sub btn_actionPerformed(oEvent)
oDlg.EndExecute
End Sub
REM Aktion Pseudo-Kopfzeilen eintragen und formatieren
Sub btnStart_actionPerformed(oEvent)
'Listener für geklonten Button
oListenerClone = CreateUnoListener("btnStart_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btnStart" & cStr(iMax))
oControl.addActionListener(oListenerClone)
Dateidialog
End Sub
REM Aktion Pseudo-Kopfzeilen löschen
Sub btnDelete_actionPerformed(oEvent1)
oListenerClone2 = CreateUnoListener("btnDelete_", "com.sun.star.awt.XActionListener")
oControl = oDlg.getControl("btnDelete" & cStr(iMax))
oControl.addActionListener(oListenerClone2)
'Dim nResult As Integer
' If bTrue=True then Exit Sub
' ' 1= OK 2 = Cancel
' nResult = MsgBox("Wollen Sie wirklich alle Texte in den Pseudo-Kopfzeilen löschen?", 305, "WARNUNG!")
'
' If nResult = 1 then
' Msgbox "Die Texte der Kopfzeilen werden gelöscht", 64, "Texte werden gelöscht!"
' bTrue=True
' Kopfzeileloeschen
' ElseIf nResult = 2 then
' Msgbox "Die Aktion wird abgebrochen!", 48, "Texte werden nicht gelöscht!"
' bTrue=True
' Exit Sub
' End If
Kopfzeileloeschen
End Sub
REM ???????????????????????? ENDE DIALOG-ROUTINE ??????????????????????????????????????????????????????????
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
Sub Dateidialog
On Error GoTo ErrorHandler
REM Laden der Bibliothek "Tools" mit den Hilfsfunktionen
GlobalScope.BasicLibraries.LoadLibrary( "Tools" )
MsgBox "Der nachfolgende Dateidialog fordert sie zum Öffnen dieser Datei auf:" & chr(10) & _
">>> Kopfzeilen_Texte.ods <<<" & chr(10) & _
"Wählen Sie zunächst den korrekten Pfad zu dieser Datei aus." ,64,"Hinweis"
' Filepicker (Datei-Dialog
ChooseAFileName
sExt=getFileNameExtension(sUrl)
' Fehlermeldung für den Fall, dass kein Calc-Dokument ausgewählt wurde
if sExt <> "ods" then
MsgBox("Bitte wählen Sie ein Calc-Dokument aus!" & chr(10) & _
"Das Programm wird beendet!" & chr(10) & chr(10) & _
"Starten Sie das Programm erneut.", 48, "Fehler: Dateiauswahl")
exit sub
end if
REM Calc-Datei im Hintergrund öffnen
Call FileOperation
REM Routine für die Pseudo-Kopfzeilen aufrufen
Call Seite
Exit Sub
REM ErrorHandler für den Fall, dass im Dateidialog auf "ABRUCH" geklickt wurde
ErrorHandler:
Msgbox "Sie haben den Dateidialog abgebrochen!" & chr(10) & _
"Starten Sie das Programm erneut und wählen eine Calc-Datei aus!", 48, "Fehler: Anwender hat Dateiauswahl abgebrochen!"
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Calc-Datei im Hintergrund öffnen
REM Dateioperation: Datei öffnen und auslesen
Sub FileOperation
n = FreeFile ' Immer nötig. Nächste freie Dateinumer
Open sUrl For Input As #n ' Datei zum Lesezugriff öffnen
Do While NOT EOF(n) ' Solange NOT End Of File
Input #n, s ' Daten werden gelesen
REM Hier werden die Daten verarbeitet
' Objekt-Eigenschaften
Dim FileProperties(1) As New com.sun.star.beans.PropertyValue
' Dokument im Hintergrund öffnen
FileProperties(0).Name = "Hidden"
FileProperties(0).Value = true
FileProperties(1).Name = "AsTemplate"
FileProperties(1).Value = true
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
' Datei öffnen
oDocC = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, FileProperties())
'mri oDocC
' Daten aus Tabelle einlesen und in die Arrays verteilen
' mArray1() = Daten für die linke Seite (gerade Seitenzahl)
mArray1()=oDocC.Sheets().getByName("KopfZeilenTexte").getCellRangeByName("A1:B10").getDataArray()
' mArray2() = Daten für die rechte Seite (ugerade Seitenzahl)
mArray2()=oDocC.Sheets().getByName("KopfZeilenTexte").getCellRangeByName("A11:B20").getDataArray()
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
' Datei nur einmal öffnen
x="true"
if x = "true" then exit do
Loop
' Calc-Datei korrekt schließen
CloseDocC
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Datei mit Filepicker öffnen
Function ChooseAFileName() As String
Dim vFileDialog ' Instanz des Service FilePicker
Dim vFileAccess ' Instanz des Service SimpleFileAccess
Dim iAccept as Integer ' Rückgabe vom FilePicker
Dim sInitPath as String ' Der Startpfad
' Achtung: Die folgenden Services müssen in dieser Reihenfolge
' aufgerufen werden, sonst wird Basic den vFileDialog nicht wieder entfernen.
vFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
vFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
' Jetzt wird der Startpfad gesetzt.
sInitPath = ConvertToUrl(CurDir)
If vFileAccess.Exists(sInitPath) Then
vFileDialog.SetDisplayDirectory(sInitPath)
End If
iAccept = vFileDialog.Execute() ' Der Dateiauswahldialog wird ausgeführt.
If iAccept = 1 Then ' Prüfung des Rückgabewerts des Dialogs.
ChooseAFileName = vFileDialog.Files(0) ' Rückgabe des Dateinamens, falls
' der Dialog nicht abgebrochen wurde.
sUrl = ChooseAFileName
End If
vFileDialog.Dispose() ' Der Dialog wird entfernt.
End Function
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM Datei korrekt schließen
Sub CloseDocC
If HasUnoInterfaces(oDocC, "com.sun.star.util.XCloseable") Then
oDocC.close(true)
Else
oDocC.dispose()
End If
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
Sub Seite
'Dim oStar as Object
'Dim oDocW as Object
Dim oCC as Object
Dim oVC as Object
Dim oText as Object
Dim oEndCursor as Object
Dim oStartCursor as Object
Dim nDiv%
'mri oStar
oDocW=ThisComponent
oCC=oDocW.CurrentController
oVC = oCC.getViewCursor
oVC.jumpToPage(2)
'mri oVC
' Berechnung der erforderlichen Durchläufe
nDiv=nSeite/10 ' 10 = Anzahl der Arrayfelder
' Schleife über je 10 Arrayfelder
for i = 0 to 9
'
for j = 0 to nDiv
' gerade Seitenzahl = linke Seite
if oVC.Page mod 2 = 0 then
With oVC
.jumpToStartOfPage(False)
.ParaStyleName="_Gl_Text-8_pt_Kopf_Gerade_Rechts bündig"
.String=mArray1(i)(1)
' .BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
.collapseToEnd
.collapseToStart
.jumpToNextPage
End With
' ungerade Seitenzahl = rechte Seite
else
With oVC
.jumpToStartOfPage(False)
.ParaStyleName="_Gl_Text-8_pt Kopf_Ungerade_Links bündig"
.String=mArray2(i)(1)
' .BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
.collapseToEnd
.collapseToStart
.jumpToNextPage
End With
end if
next j
next i
MsgBox("Die Kopfzeileninhalte wurden ab Seite 2 bis zur Seite " & nSeite & " eingetragen!", 64, "Programmende: Kopfzeilen-Einträge")
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
Sub Kopfzeileloeschen
Dim oCC as Object
Dim oVC as Object
Dim oText as Object
Dim oEndCursor as Object
Dim oStartCursor as Object
Dim nDiv%
oDocW=ThisComponent
oCC=oDocW.CurrentController
oVC = oCC.getViewCursor
oVC.jumpToPage(2)
'mri oVC
' Berechnung der erforderlichen Durchläufe
nDiv=nSeite/10 ' 10 = Anzahl der Arrayfelder
' Schleife über je 10 Arrayfelder
for i = 0 to 9
for j = 0 to nDiv
' gerade Seitenzahl = linke Seite
if oVC.Page mod 2 = 0 then
With oVC
.jumpToStartOfPage(False)
.ParaStyleName="_Gl_Text-8_pt_Kopf_Gerade_Rechts bündig"
.gotoEndOfLine(true)
.String="" 'mArray1(i)(1)
' .BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
.collapseToEnd
.collapseToStart
.jumpToNextPage
End With
' ungerade Seitenzahl = rechte Seite
else
With oVC
.jumpToStartOfPage(False)
.ParaStyleName="_Gl_Text-8_pt Kopf_Ungerade_Links bündig"
.gotoEndOfLine(true)
.String="" 'mArray2(i)(1)
' .BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
.collapseToEnd
.collapseToStart
.jumpToNextPage
End With
end if
next j
next i
MsgBox("Die Kopfzeileninhalte wurden von Seite 2 bis " & nSeite & " gelöscht!", 15, "Programmende: Kopfzeilen-Löschung")
End Sub
REM ???????????????????????????????????????????????????????????????????????????????????????????????????????
[/code]