vb@rchiv · Tipps & Tricks · Auto-Indent für TextFeld in ACCESS 2000

Rubrik: Access | VB-Versionen: VBA

21.12.04

Auto-Indent für TextFeld in ACCESS 2000 Dieser Tipp zeigt, wie sich eine AutoIndent-Funktion für die Standard-TextBox von MS-Access realisieren lässt - so wie man es vom VBA-Editor her kennt und gewohnt ist.
Autor: Richard Mittelstädt	Bewertung:	Views: 13.908
ohne Homepage	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	kein Beispielprojekt

In Anlehnung an den Tipp Auto-Indent für die (RTF)TextBox möchten wir Ihnen heute zeigen, wie sich eine AutoIndent-Funktion für die Standard-TextBoxen unter MS-Access realisieren lässt.

Option Explicit
 
' In Anlehnung an:
' http://www.vbarchiv.net/archiv/tipp_1162.html
' von Jürgen Sorko
' abgeaendert für ACCESS, 2004-12-09 rimi

Public Function autoIndent(oTextBox As Object)
  ' *********************************************************************
  ' Rückt den Text ein bei ENTER (wie in der vorhergehenden Zeile)
  ' *********************************************************************
  ' Die Eigenschaft "Eingabetastenverhalten" des Textfeldes
  ' steht auf "Neue Zeile im Feld"
  ' ------------------------------------------------------------
  ' Beispiel für FunktionsAufruf im Formular-Code (Bei Taste) :
  ' ------------------------------------------------------------
  '    Private Sub Test_Text_KeyPress(KeyAscii As Integer)
  '      If KeyAscii = vbKeyReturn Then
  '        ' Beim Drücken von Return, neuen Absatz autom. einrücken
  '        KeyAscii = 0
  '        Call autoIndent(Screen.ActiveControl)
  '      End If
  '    End Sub
  ' ********************************************************************
  Dim nSpaces As Long
  Dim OLD_START As Long
 
  With oTextBox
    OLD_START = .SelStart
    ' Anzahl Leerzeichen der aktuellen Zeile
    nSpaces = getLastSpaces(.Text, .SelStart)
    If OLD_START = Len(.Text) Then
      ' Sonderfall letzte zeile,ACCESS löscht Leerzeichen am Ende!
      ' Deshalb wird dieValue-Eigenschaft verwendet
      .Value = .Text & vbNewLine & Space$(nSpaces)
    Else
      ' Zeilenumbruch und Anzahl ermittelter Leerzeichen einfügen
      ' an die aktuelle Cursor-Position
      .SelStart = OLD_START
      Dim OLD_AFTER
      OLD_AFTER = .AfterUpdate    ' merken Aktualisierung-Ereignis
      .AfterUpdate = ""           ' Abblocken des Nach Aktualisierung-Ereignisses
      .SelText = vbNewLine & Space$(nSpaces)  ' Löst aus !
      .AfterUpdate = OLD_AFTER    ' Wieder aktivieren
    End If
    ' Cursor positionieren
    .SelStart = OLD_START + nSpaces + 2
  End With
End Function

Public Function getLastSpaces(ByVal sText As String, _
  nCurPos As Long) As Long
  ' **************************************************************
  ' Gibt die Anzahl der führenden Leerzeichen der
  ' aktuellen Zeile im TextFeld-Control aus
  ' **************************************************************
  ' Fehlerbehanldung aktivieren (sicher ist sicher)
  On Error Resume Next
  Dim nPos As Long
  Dim nSpaces As Long
 
  ' position des 1. NewLine vor akt. pos.
  nPos = InStrRev(Left$(sText, nCurPos), vbNewLine)
  If nPos > 0 Then    ' Newline gefunden
    nPos = nPos + 2
    ' String,Start,Länge,Leerzeichen zählen
    While Mid$(sText, nPos, 1) = " "
      nSpaces = nSpaces + 1
      nPos = nPos + 1
    Wend
  ElseIf nPos = 0 Then
    ' kein Newline gefunden (=ErsteZeile)
    nPos = 1
    ' String,Start,Länge,Leerzeichen zählen
    While Mid$(sText, nPos, 1) = " "
      nSpaces = nSpaces + 1
      nPos = nPos + 1
    Wend
  End If
  getLastSpaces = nSpaces
End Function