Otomatik Tamamlama

Option Explicit
Const StringL As Long = 20 'Tamamlanacak max karakter uzunluğu 
Private WithEvents TB As TextBox
Private NumberOfItems As Long, sItems As String, LastFill As String
Public OnlyAllowList As Boolean
Property Set AutoCompleteTextbox(T As TextBox)
    Set TB = T
    LastFill = ""
    TB_GotFocus
End Property
Private Property Get Item(ByVal Index As Long) As String
    Item = Mid$(sItems, Index * StringL + 1, StringL)
End Property
Public Sub AddItem(sInput As String) 'tamamlama için metin eklenmesi
    If Len(sInput) = 0 Then Exit Sub
    Dim S As String * StringL
    S = sInput
    Dim I&
    For I = 0 To NumberOfItems - 1
        If Item(I) > S Then Exit For
    Next
    If I = NumberOfItems Then
        sItems = sItems & S
    Else
        I = I * StringL
        sItems = Left$(sItems, I) & S & Mid$(sItems, I + 1)
    End If
    NumberOfItems = NumberOfItems + 1
End Sub
Property Get GetList() As String()
    Dim Arr() As String, I&
    ReDim Arr(NumberOfItems - 1)
    For I = 0 To NumberOfItems - 1
        Arr(I) = RTrim$(Item(I))
    Next
    GetList = Arr
End Property
Sub ShowList() 'eklenmiş olan metinlerin gösterimi
    Dim I&, S$
    For I = 0 To NumberOfItems - 1
        S = S & vbCrLf & Item(I)
    Next
    MsgBox "Loaded lists consists of:" & vbCrLf & S, vbInformation
End Sub
Private Sub Class_Terminate()
    Set TB = Nothing
End Sub
Private Sub TB_GotFocus()
    TB.SelStart = 0
    TB.SelLength = Len(TB.Text)
End Sub
Private Sub TB_KeyPress(KeyAscii As Integer) 'texte girilen 'karakterlerin kontrolü ve tamamlanması/tamamlanmaması
    If KeyAscii < 32 Then
        LastFill = ""
        Exit Sub
    End If
    Dim P As Long, C As String * 1
    C = Chr$(KeyAscii)
    P = TB.SelStart + 1
    If Len(LastFill) Then
        If StrComp(Mid$(LastFill, P, 1), C, vbTextCompare) = 0 Then
            TB.SelStart = P
            TB.SelLength = Len(TB.Text)
            KeyAscii = 0
            Exit Sub
        End If
    End If
    Dim strText As String
    strText = Left$(TB.Text, P - 1) & C
    If Len(strText) = 0 Then Exit Sub
    P = 0
    Do
        P = InStr(P + 1, sItems, strText, vbTextCompare)
        If P = 0 Then Exit Do
        If (P - 1) Mod StringL = 0 Then
            LastFill = RTrim$(Item(P \ StringL))
            P = Len(strText)
            TB.Text = strText & Mid$(LastFill, P + 1)
            TB.SelStart = P
            TB.SelLength = Len(TB.Text)
            KeyAscii = 0
            Exit Sub
        End If
    Loop
    If OnlyAllowList Then
        Beep
        KeyAscii = 0
    Else
        LastFill = ""
    End If
End Sub
Private Sub TB_Validate(Cancel As Boolean)
    If TB.SelLength > 0 And Len(LastFill) > 0 Then
        
        TB.Text = LastFill
    End If
End Sub
'modül kısmı bu kadar.......

Private Sub Form_Load()
    
    Dim veri As String
    Set AutoComplete = New clsAutoComplete 'modüülümüzü tanımlıyoruz
'1    
    Open App.Path & "\htad.hta" For Input As #1 'projenin 'bulunduğu klasöre önceden htad.hta diye bir metin dosyası 'acmayı unutmayın
        Do Until EOF(1)
        
            Input #1, veri
            AutoComplete.AddItem veri 'önceden kullanılmış 'verileri dahil ediyoruz
    Loop
    Close #1
'2       
End Sub

Private Sub Text1_GotFocus()
    Set AutoComplete.AutoCompleteTextbox = Text1
End Sub

Private Sub Command1_Click()
veri = Text1.Text
List1.AddItem veri
AutoComplete.AddItem veri
'1
    Open App.Path & "\htad.hta" For Append As #1
                
        Print #1, veri
            
    Close #1
'2
Text1.SetFocus
End Sub