Ich fand die Idee, Zeilen ein- und auskommentieren sowie Ein- und Ausrücken zu können, super. Ich habe das hier mit Hilfe von ChatGPT und Claude umgearbeitet für LibreOffice 25.8.2. Leider ist es mir trotz hohen Zeitaufwands nicht gelungen, das Modul so anzupassen, dass eine evtl. Markierung erhalten bleibt. Wenn man also mehrmals einrücken möchte, muss man jeweils wieder neu markieren. Vielleicht hat ja jemand eine Idee dazu.
Die Einrichtung ist dieselbe. Den Code unter "Meine Makros" in einem Modul abspeichern und jedem Funktionsaufruf (das sind die ersten vier Prozeduren) eine Tastenkombination zuweisen (Extras / Anpassen... und im Dialog die Registerkarte "Tastatur" wählen). Viel Erfolg!
Code: Alles auswählen
REM ***** BASIC *****
Option Explicit
'=========================================================
' Einrücker / Kommentierer für LibreOffice Basic IDE
'
' Ansatz: arbeitet über "Paragraph-Objekte" im Basic-IDE
' (jedes Kind im TextFrame entspricht einer Code-Zeile).
'
' Hinweis: In vielen LO-Versionen liefert das Accessibility-
' Textobjekt bei Block-Markierungen nur einen Selektions-"Proxy".
' Dann lässt sich die Mehrzeilen-Auswahl nicht zuverlässig über
' SelectionStart/End/Caret bearbeiten. Dieses Modul umgeht das,
' indem es direkt auf den Zeilen-Objekten arbeitet.
'=========================================================
'=========================================================
' Konfiguration
'=========================================================
Private Const INDENT_SPACES As String = " " '2 Leerzeichen
Private Const COMMENT_CHAR As String = "'" 'Apostroph
'==============================
' Finetuning
'==============================
'4) Whitespace-only Zeilen NICHT überspringen (True = auch Leer-/Leerzeichen-Zeilen bearbeiten)
Private Const FT_PROCESS_WHITESPACE_ONLY As Boolean = True
'=========================================================
' Öffentliche Makros (für Tastenkürzel)
'=========================================================
Public Sub pCodeLn_Com_ON()
'Zeilen (ent-)kommentieren: Kommentar setzen - Ctrl+K
pCodeLines True, False
End Sub
Public Sub pCodeLn_Com_OFF()
'Zeilen (ent-)kommentieren: Kommentar entfernen - Ctrl-N
pCodeLines True, True
End Sub
Public Sub pCodeLn_Mov_R()
'Zeilen einrücken - Ctrl-R
pCodeLines False, False
End Sub
Public Sub pCodeLn_Mov_L()
'Zeilen ausrücken - Ctrl-L
pCodeLines False, True
End Sub
'=========================================================
' Hauptlogik
'=========================================================
Private Sub pCodeLines(ByVal bolREM As Boolean, ByVal bolCUT As Boolean)
On Error GoTo EH
Dim oBasicComp As Object
oBasicComp = getBasicWindow()
If (oBasicComp Is Nothing) Then
MsgBox "Basic-IDE wurde nicht gefunden. Öffne ein Modul im Basic-Editor und versuche es erneut.", 48, "Einrücker"
Exit Sub
End If
Dim oContWin As Object
oContWin = oBasicComp.CurrentController.Frame.ComponentWindow
'1) TextFrame finden, dessen Kinder die "Paragraphen/Zeilen" sind
Dim oTextFrame As Object
oTextFrame = FindTextFrameWithParas_(oContWin)
If (oTextFrame Is Nothing) Then
MsgBox "Kein TextFrame mit Zeilen-Objekten im Basic-IDE gefunden." & Chr(10) & _
"Tipp: Klicke in den Codebereich (Cursor sichtbar) und starte erneut.", 48, "Einrücker"
Exit Sub
End If
'2) Selektierte Zeilen ermitteln
Dim aSel As Variant
aSel = GetSelectedParaIndexes_(oTextFrame)
If Not IsEmpty(aSel) Then
ApplyToParas_ oTextFrame, aSel, bolREM, bolCUT
'Markierung kann in manchen Builds nicht erhalten bleiben -> UX-Fallback:
'Cursor/Fokus auf die erste betroffene Zeile setzen.
FocusFirstAffectedLine_ oTextFrame, aSel
Exit Sub
End If
'3) Kein Block selektiert: Fokuszeile finden und darauf anwenden
Dim idx As Long
idx = FindFocusedParaIndex_(oTextFrame)
If idx < 0 Then
MsgBox "Keine Zeilen markiert und keine Fokuszeile gefunden." & Chr(10) & _
"Tipp: Markiere Zeilen oder setze den Cursor in eine Zeile.", 48, "Einrücker"
Exit Sub
End If
Dim one(0) As Long
one(0) = idx
ApplyToParas_ oTextFrame, one, bolREM, bolCUT
FocusSingleLine_ oTextFrame, idx
Exit Sub
EH:
MsgBox "Fehler pCodeLines: " & Err & " - " & Error$, 16, "Einrücker"
End Sub
'=========================================================
' Anwenden auf Zeilen-Objekte
'=========================================================
Private Sub ApplyToParas_(oTextFrame As Object, aIdx As Variant, ByVal bolREM As Boolean, ByVal bolCUT As Boolean)
On Error GoTo EH
Dim k As Long
For k = LBound(aIdx) To UBound(aIdx)
Dim oPara As Object
oPara = oTextFrame.AccessibleContext.getAccessibleChild(CLng(aIdx(k)))
If Not (oPara Is Nothing) Then
ApplyToOnePara_ oPara, bolREM, bolCUT
End If
Next k
Exit Sub
EH:
MsgBox "Fehler ApplyToParas_: " & Err & " - " & Error$, 16, "Einrücker"
End Sub
Private Sub ApplyToOnePara_(oPara As Object, ByVal bolREM As Boolean, ByVal bolCUT As Boolean)
On Error GoTo EH
Dim sLine As String
sLine = GetParaText_(oPara)
'Finetuning (4): Whitespace-only Zeilen optional NICHT überspringen
If (Not FT_PROCESS_WHITESPACE_ONLY) Then
If Trim$(sLine) = "" Then Exit Sub
End If
Dim lead As Long
lead = LeadWSLen_(sLine)
If bolREM Then
If bolCUT Then
'=================================================
' Rückgängigmachen der Auskommentierung:
' - löscht genau EIN Kommentarzeichen nach führendem WS
' - entfernt anschließend EIN direkt folgendes Leerzeichen/Tab (falls vorhanden)
' (prüft damit, ob unser Tool "' " gesetzt hat)
'=================================================
sLine = GetParaText_(oPara)
lead = LeadWSLen_(sLine)
If IsCommentedAfterWS_(sLine, lead) Then
'Ein Kommentarzeichen entfernen
oPara.cutText lead, lead + 1
'Optional ein nachfolgendes Leerzeichen/Tab entfernen
Dim sAfter As String
sAfter = GetParaText_(oPara)
If lead < Len(sAfter) Then
Dim ch1 As String
ch1 = Mid$(sAfter, lead + 1, 1)
If (ch1 = " ") Or (ch1 = Chr(9)) Then
oPara.cutText lead, lead + 1
End If
End If
End If
Else
'=================================================
' Auskommentieren:
' - lässt bestehende Kommentarzeichen bestehen
' - fügt zusätzlich EIN Kommentarzeichen nach führendem WS ein
' - fügt danach EIN Leerzeichen ein (Stil: "' ")
'=================================================
oPara.insertText COMMENT_CHAR & " ", lead
End If
Else
If bolCUT Then
'2 Leerzeichen entfernen (am Zeilenanfang)
Dim i As Long
For i = 1 To 2
sLine = GetParaText_(oPara)
If Len(sLine) > 0 Then
If Left$(sLine, 1) = " " Then
oPara.cutText 0, 1
Else
Exit For
End If
Else
Exit For
End If
Next i
Else
'2 Leerzeichen einfügen (am Zeilenanfang)
oPara.insertText INDENT_SPACES, 0
End If
End If
Exit Sub
EH:
'Pro Zeile: nicht hart abbrechen
End Sub
'=========================================================
' Selektion / Fokus im TextFrame
'=========================================================
Private Function GetSelectedParaIndexes_(oTextFrame As Object) As Variant
On Error GoTo EH
Dim n As Long
n = oTextFrame.AccessibleContext.AccessibleChildCount
If n <= 0 Then
GetSelectedParaIndexes_ = Empty
Exit Function
End If
Dim tmp() As Long
ReDim tmp(n - 1) As Long
Dim iCount As Long
iCount = 0
Dim k As Long
For k = 0 To n - 1
Dim oPara As Object
oPara = oTextFrame.AccessibleContext.getAccessibleChild(k)
If Not (oPara Is Nothing) Then
Dim t As String, sel As String
t = GetParaText_(oPara)
sel = GetParaSelectedText_(oPara)
'Eine Zeile gilt als selektiert, wenn die komplette Zeile selektiert ist
If (t <> "") And (sel <> "") And (sel = t) Then
tmp(iCount) = k
iCount = iCount + 1
End If
End If
Next k
If iCount <= 0 Then
GetSelectedParaIndexes_ = Empty
Else
ReDim Preserve tmp(iCount - 1) As Long
GetSelectedParaIndexes_ = tmp
End If
Exit Function
EH:
GetSelectedParaIndexes_ = Empty
End Function
Private Function FindFocusedParaIndex_(oTextFrame As Object) As Long
On Error GoTo EH
Dim n As Long
n = oTextFrame.AccessibleContext.AccessibleChildCount
If n <= 0 Then
FindFocusedParaIndex_ = -1
Exit Function
End If
'Versuch 1: CaretPosition auf Para-Objekt
Dim k As Long
For k = 0 To n - 1
Dim oPara As Object
oPara = oTextFrame.AccessibleContext.getAccessibleChild(k)
If Not (oPara Is Nothing) Then
Dim cp As Long
cp = -1
On Error Resume Next
cp = oPara.getCaretPosition()
On Error GoTo EH
If cp >= 0 Then
FindFocusedParaIndex_ = k
Exit Function
End If
End If
Next k
'Versuch 2: FOCUSED State
For k = 0 To n - 1
Dim oP As Object, oCtx As Object, oState As Object
oP = oTextFrame.AccessibleContext.getAccessibleChild(k)
If Not (oP Is Nothing) Then
oCtx = oP.AccessibleContext
If Not (oCtx Is Nothing) Then
oState = oCtx.AccessibleStateSet
If Not (oState Is Nothing) Then
If oState.contains(com.sun.star.accessibility.AccessibleStateType.FOCUSED) Then
FindFocusedParaIndex_ = k
Exit Function
End If
End If
End If
End If
Next k
FindFocusedParaIndex_ = -1
Exit Function
EH:
FindFocusedParaIndex_ = -1
End Function
'=========================================================
' TextFrame finden (dessen Kinder die Code-Zeilen sind)
'=========================================================
Private Function FindTextFrameWithParas_(oRoot As Object) As Object
On Error GoTo EH
FindTextFrameWithParas_ = FindTextFrameWithParasRec_(oRoot, 30)
Exit Function
EH:
FindTextFrameWithParas_ = Nothing
End Function
Private Function FindTextFrameWithParasRec_(oNode As Object, ByVal depth As Long) As Object
On Error GoTo EH
If oNode Is Nothing Then Exit Function
If depth < 0 Then Exit Function
Dim oCtx As Object
oCtx = oNode.AccessibleContext
If Not (oCtx Is Nothing) Then
Dim n As Long
n = oCtx.AccessibleChildCount
'Heuristik: ein "TextFrame" hat viele Kinder, und mehrere davon sind editierbare Text-Zeilen.
If n > 5 Then
Dim okCount As Long
okCount = 0
Dim i As Long
For i = 0 To n - 1
Dim oChild As Object
oChild = SafeGetChildFromCtx_(oCtx, i)
If Not (oChild Is Nothing) Then
If HasUnoInterfaces(oChild, "com.sun.star.accessibility.XAccessibleEditableText") Then
Dim t As String
t = GetParaText_(oChild)
If t <> "" Then okCount = okCount + 1
End If
End If
If okCount >= 3 Then
FindTextFrameWithParasRec_ = oNode
Exit Function
End If
Next i
End If
'Rekursiv weiter
Dim j As Long
For j = 0 To n - 1
Dim oCh As Object, oFound As Object
oCh = SafeGetChildFromCtx_(oCtx, j)
If Not (oCh Is Nothing) Then
oFound = FindTextFrameWithParasRec_(oCh, depth - 1)
If Not (oFound Is Nothing) Then
FindTextFrameWithParasRec_ = oFound
Exit Function
End If
End If
Next j
End If
Exit Function
EH:
'ignorieren
End Function
'=========================================================
' Para-Text und SelectedText robust lesen
'=========================================================
Private Function GetParaText_(oPara As Object) As String
On Error GoTo EH
Dim t As String
t = ""
On Error Resume Next
t = oPara.Text
If t = "" Then
t = oPara.getText()
End If
On Error GoTo EH
GetParaText_ = t
Exit Function
EH:
GetParaText_ = ""
End Function
Private Function GetParaSelectedText_(oPara As Object) As String
On Error GoTo EH
Dim t As String
t = ""
On Error Resume Next
t = oPara.SelectedText
If t = "" Then
t = oPara.getSelectedText()
End If
On Error GoTo EH
GetParaSelectedText_ = t
Exit Function
EH:
GetParaSelectedText_ = ""
End Function
'=========================================================
' UX-Fallback: Cursor/Fokus setzen
'=========================================================
Private Sub FocusFirstAffectedLine_(oTextFrame As Object, aIdx As Variant)
On Error GoTo EH
If (oTextFrame Is Nothing) Then Exit Sub
If IsEmpty(aIdx) Then Exit Sub
Dim firstIdx As Long, k As Long, v As Long
firstIdx = CLng(aIdx(LBound(aIdx)))
For k = LBound(aIdx) To UBound(aIdx)
v = CLng(aIdx(k))
If v < firstIdx Then firstIdx = v
Next k
FocusSingleLine_ oTextFrame, firstIdx
Exit Sub
EH:
End Sub
Private Sub FocusSingleLine_(oTextFrame As Object, ByVal idx As Long)
On Error GoTo EH
Dim oCtx As Object, oPara As Object
oCtx = oTextFrame.AccessibleContext
If (oCtx Is Nothing) Then Exit Sub
oPara = oCtx.getAccessibleChild(idx)
If (oPara Is Nothing) Then Exit Sub
TryRequestFocus_ oPara
On Error Resume Next
oPara.setSelection 0, 0
oPara.setCaretPosition 0
On Error GoTo EH
Exit Sub
EH:
End Sub
Private Sub TryRequestFocus_(oObj As Object)
On Error Resume Next
If (oObj Is Nothing) Then Exit Sub
Dim oCtx As Object, oParent As Object
oCtx = oObj.AccessibleContext
If Not (oCtx Is Nothing) Then
oCtx.requestFocus()
If Err = 0 Then Exit Sub
Err = 0
oParent = oCtx.AccessibleParent
If Not (oParent Is Nothing) Then
oParent.AccessibleContext.requestFocus()
Err = 0
End If
End If
End Sub
'=========================================================
' Finetuning-Helfer
'=========================================================
Private Function LeadWSLen_(ByVal s As String) As Long
'Zählt führende Leerzeichen und Tabs.
Dim n As Long, i As Long
n = Len(s)
i = 1
Do While i <= n
Dim ch As String
ch = Mid$(s, i, 1)
If (ch = " ") Or (ch = Chr(9)) Then
i = i + 1
Else
Exit Do
End If
Loop
LeadWSLen_ = i - 1 '0-basiert für UNO-Indices
End Function
Private Function IsCommentedAfterWS_(ByVal s As String, ByVal lead As Long) As Boolean
'Prüft, ob nach führendem WS ein Apostroph steht.
Dim n As Long
n = Len(s)
If lead < n Then
IsCommentedAfterWS_ = (Mid$(s, lead + 1, 1) = COMMENT_CHAR)
Else
IsCommentedAfterWS_ = False
End If
End Function
'=========================================================
' Basic-IDE-Fenster finden
'=========================================================
Private Function getBasicWindow() As Object
On Error GoTo EH
Dim oEnum As Object, oComp As Object
oEnum = StarDesktop.Components.createEnumeration()
While oEnum.hasMoreElements()
oComp = oEnum.nextElement()
If HasUnoInterfaces(oComp, "com.sun.star.lang.XServiceInfo") Then
If oComp.supportsService("com.sun.star.script.BasicIDE") Then
getBasicWindow = oComp
Exit Function
End If
End If
Wend
getBasicWindow = Nothing
Exit Function
EH:
getBasicWindow = Nothing
End Function
'=========================================================
' Hilfsfunktionen
'=========================================================
Private Function SafeGetChildFromCtx_(oCtx As Object, ByVal idx As Long) As Object
On Error GoTo EH
SafeGetChildFromCtx_ = oCtx.getAccessibleChild(idx)
Exit Function
EH:
SafeGetChildFromCtx_ = Nothing
End Function