Txtbox opdager foruddefineret indtastning # 2

Hej Nicolaus.

Det er vel ikke svært, der skal bare en del linier til.

Hvis du under txtfelt > change anvender: If instr(tekst,\"01\")>0 then...  kan du få udført det du efterspørger.  Læs om Instr i hjælpen.  Måske kommer der en der vil skrive det hele.  Jeg går ikke selv op i point.

M.v.h.  Jørn

Tak Jørn, for din beskrivelse.

Men jeg kan ikke få det til at virke. Jeg må så
også tilstå at jeg ikke forstår forklaringen i hjælp.

Vers\'go, du skal bare tilføje de udskiftninger du skal bruge ud over 01 og 02.

Private Sub Text1_Change()
    Text1.Text = Replace(Text1.Text, \"01\", \"test\")
    Text1.Text = Replace(Text1.Text, \"02\", \"test2\")
End Sub

Jo det vil virke, men ønsker man at cursoren skal stå det samme sted efter koden er skiftet, vil jeg mener at man skal ligge en counter ind, så cursoren ikke hopper tilbage til start hele tiden.

Det har du da helt ret i powell.

Hvad med...

Private Sub Text1_Change()
  If Mid(Text1.Text, Text1.SelStart - 1, 2) = \"01\" Then
    Text1.SelStart = Text1.SelStart - 2
    Text1.SelLength = 2
    Text1.SelText = \"test\"
  End If
End Sub

Så skulle den løbende checke... Virker ikke ved Cut\'n Paste

Tak, winkill. Men koden funger ikke. VBA kender ikke \"Replace\" ??

Koden skal placeres i VBA for Excel

Claus

Winkill> Det burde fungere også i VBA for Excel

Gør ovenstående ikke det ? Det bruger ikke Replace.

Virker ikke.

Jeg skriver:

Private Sub Text1_Change()
  If Mid(Text1.Text, Text1.SelStart - 1, 2) = \"01\" Then
    Text1.SelStart = Text1.SelStart - 2
    Text1.SelLength = 2
    Text1.SelText = \"test\"
  End If
End Sub

Men får fejlkoden:
Procedurekaldet eller argumentet er ugyldigt (fejl 5) - med linien If mid(... ) udpeget ???

Hmmm, strange, jeg laver lige en anden version så.

Ok, så skulle den være der. Hvis det giver problemer så ser jeg nok først på det senere... jeg skal lige passe mit job lidt ;-)

Private Sub Text1_Change()
    Dim intPos As Integer
    Dim intStart As Integer
    Dim intLength As Integer
    With Text1
        intStart = .SelStart
        intLength = .SelLength
        intPos = InStr(1, .Text, \"01\")
        While intPos > 0
            .Text = Left(.Text, intPos - 1) & \"test\" & Mid(.Text, intPos + 2)
            intStart = intStart + Len(\"test\") - Len(\"01\")
            intPos = InStr(intPos, .Text, \"01\")
        Wend
        .SelStart = intStart
        .SelLength = intLength
    End With
End Sub

Hej winkill.

Det fungede om end koden er lidt kringlet. Kan det virkelig ikke gøres mere overskueligt?

Jeg har selv lavet en kode, der ligger i en case sætning. Her isættes \"0\" i en Dim Holder0 og \"1\" i Dim Holder1 as boolean. Så snart begge er true, slettes sidst indtastede bogstav (1) og erstattes med \"test\". Men dette resulterede i forskellige bugs.

Men det må da kunne gøres med case osv.?!

Tak!!!

Claus

Det kan det også, problemet er følgende.
Hvis du har teksten \"habla-nohable\" og så indtaster \"01\" i stedet for \"-\" så skulle curseren gerne ende mellem \"test\" og \"nohabla\". Derfor skal lengden af \"test\" - lengden af \"01\" lægges til curserens startposition.

Men det kan helt sikkert laves i en Select Case ting, det skal bare gøres ordentligt.

En anden mulighed er at pakke det ind i en Sub, som du så sender Text1 objektet samt det to stykker tekst der skal udskiftes. Men det er en helt andet historie og den får i i aften. ;o)

Hej winkill

Kan du ikke (please) fortælle mig (vise mig), hvordan jeg koder jeg det i en case sætning?
ELLER
Hvordan jeg koder således, at jeg kan tilføje flere koder som f.eks. hvis \"02\" indtastes skal ... ske eller hvis \"08\" indtastes skal ... osv.

Jeg ved jeg beder om meget, men har hårdt brug for det. Hvis jeg så bare kunne forstå din kode :-o.

Håb, håb!!!

Claus

Hej.

Der er sket meget i dagens løb.  Det vil være nyttigt om spørgere angiver dels hvilken version de benytter, når det er VB, men da især når det \"kun\" er VBA, og da til Office-version....
Men Nicolaus er i gode hænder, ser jeg.  Winkill har før hjulpet mig, så dér kan jeg ikke være med.
M.v.h.  Jørn

Sorry, min tid har mildest talt været totalt booket af arbejdet de sidste par dage, men jeg mixer lige et stykke kode sammen som:
1) Kan håndterer alle text_change events.
2) Er let at arbejde med uanset hvor mange \"koder\" der skal udskiftes.
3) Fungerer.

I shall return later...

PS. Jørn, tak men jeg er sikker på at du også kan lære mig et par ting om kodning, vi arbejder vidst med udvikling af vidt forskellige typer applikationer.

Vers\'go, dette skulle helst løse alle dine kvaler. Jeg har ikke brugt Select Case, da jeg mener at det ville gå for langsome.

Der er tre ting der skal rettes for at det vil komme til at virke.
1) Der hvor der står \"Set objTextBox = Text1\" skal du rette \"Text1\" til navnet på din textbox sådan at programmet ved hvilken textbox det drejer sig om - det gælder også for selve procedure/event navnet.
2) Du skal tilføje dine egne koder der hvor der står \"strCharCodes() = Array(\"01\", \"02\", \"03\")\" du kunne eks. skrive \"strCharCodes() = Array(\"kodeA\", \"kodeB\", \"kodeC\")\"
3) Du skal angive hvad hver enkelt kode skal udskiftes med der hvor der står \"strCCText() = Array(\"Test1\", \"Test2\", \"Test3\")\" Du kunne eksempelvis skrive \"strCCText() = Array(\"Jensen\", \"Hansen\", \"Mortensen\")\"

Derudover skulle der ikke være noget at tilføje andet end koden. Den kommer her:

Private Sub Text1_Change()
    Dim objTextBox As TextBox
   
    \' VIGTIGT!! Hvis du ikke bruger Text1 som textbox skal du rette nedenstående.
    \' Eks. Hvis din textbox hedder \"txtRedigeringsfelt\" skal nedenstående linie rettes til:
    \' Set objTextBox = txtRedigeringsfelt
    Set objTextBox = Text1
   
    If Len(objTextBox.Text) = 0 Then Exit Sub \' Hvis der ikke står noget i objTextBox så smutter vi bare videre ;o)
   
    \' Gør et par variabler klar til brug.
   
    Dim strCharCodes()
    Dim strCCText()
    Dim intCharCodeCounter As Integer
   
    Dim intPosition As Integer
    Dim strFoer As String
    Dim strEfter As String
   
    Dim intStartPos As Integer
    Dim intLength As Integer
   
    \' Her kan du tilføje de koder der skal bruges.
    strCharCodes() = Array(\"01\", \"02\", \"03\")
    \' Her kan du angive hvad hver enkelt kode skal erstattes med.
    strCCText() = Array(\"Test1\", \"Test2\", \"Test3\")
    s
    \' Husk hvor courseren er inden vi starter.
    intStartPos = objTextBox.SelStart
    intLength = objTextBox.SelLength
   
    For intCharCodeCounter = LBound(strCharCodes) To UBound(strCharCodes)
        \' Denne del skal løbes igennem én gang for hver kode der skal ændres.
        intPosition = InStr(1, objTextBox.Text, strCharCodes(intCharCodeCounter)) \' Find næste kode
        While intPosition > 0 \' Så længe der bliver fundet flere koder.
            \' Koden udskiftes med den rette tekst
            strFoer = Left(objTextBox.Text, intPosition - 1)
            strEfter = Mid(objTextBox.Text, intPosition + Len(strCharCodes(intCharCodeCounter)))
            objTextBox.Text = strFoer & strCCText(intCharCodeCounter) & strEfter
            \' Der skal tages højde for at coursorens position forskydes hvis koden ikke har samme længde som den tekst der bliver indsat i stedet for koden.
            intStartPos = intStartPos + Len(strCCText(intCharCodeCounter)) - Len(strCharCodes(intCharCodeCounter))
            \' Find næste kode
            intPosition = InStr(1, objTextBox.Text, strCharCodes(intCharCodeCounter))
        Wend
    Next intCharCodeCounter
   
    \' Sæt courseren der hvor den var da vi startede.
    objTextBox.SelStart = intStartPos
    objTextBox.SelLength = intLength
End Sub

Ups, beskrivelsen kommer lige igen her, i en lidt mere overskuelig version.

Der er tre ting der skal rettes for at det vil komme til at virke.

1) Der hvor der står \"Set objTextBox = Text1\" skal du rette \"Text1\"
  til navnet på din textbox sådan at programmet ved hvilken textbox
  det drejer sig om - det gælder også for selve procedure/event navnet.

2) Du skal tilføje dine egne koder der hvor der står
  \"strCharCodes() = Array(\"01\", \"02\", \"03\")\" du kunne eks. skrive
  \"strCharCodes() = Array(\"kodeA\", \"kodeB\", \"kodeC\")\"

3) Du skal angive hvad hver enkelt kode skal udskiftes med der hvor
  der står \"strCCText() = Array(\"Test1\", \"Test2\", \"Test3\")\" Du kunne
  eksempelvis skrive \"strCCText() = Array(\"Jensen\", \"Hansen\", \"Mortensen\")\"

MANGE TAK winkill !!!!!!!!

Det var en ordentlig mundfuld.

Men jeg må desværre observere, at koden ikke virker helt endnu. Når jeg kører programmet eller fejlfinding, standser den op ved \"strcharcodes\" og \"strcctext\" med meddelelsen: Kan ikke tildele til matrix ?????

Hvad gør jeg forkert?

Jeg går ud fra at det er disse linier du hentyder til:

\' Her kan du tilføje de koder der skal bruges.
strCharCodes() = Array(\"01\", \"02\", \"03\")
\' Her kan du angive hvad hver enkelt kode skal erstattes med.
strCCText() = Array(\"Test1\", \"Test2\", \"Test3\")

I så fald skulle dette kunne rette det.

Private Sub Text1_Change()
    Dim objTextBox As TextBox
   
    \' VIGTIGT!! Hvis du ikke bruger Text1 som textbox skal du rette nedenstående.
    \' Eks. Hvis din textbox hedder \"txtRedigeringsfelt\" skal nedenstående linie rettes til:
    \' Set objTextBox = txtRedigeringsfelt
    Set objTextBox = Text1
   
    If Len(objTextBox.Text) = 0 Then Exit Sub \' Hvis der ikke står noget i objTextBox så smutter vi bare videre ;o)
   
    \' Gør et par variabler klar til brug.
   
    Dim strCharCodes
    Dim strCCText
    Dim intCharCodeCounter As Integer
   
    Dim intPosition As Integer
    Dim strFoer As String
    Dim strEfter As String
   
    Dim intStartPos As Integer
    Dim intLength As Integer
   
    \' Her kan du tilføje de koder der skal bruges.
    strCharCodes = Array(\"01\", \"02\", \"03\")
    \' Her kan du angive hvad hver enkelt kode skal erstattes med.
    strCCText = Array(\"Test1\", \"Test2\", \"Test3\")
   
    \' Husk hvor courseren er inden vi starter.
    intStartPos = objTextBox.SelStart
    intLength = objTextBox.SelLength
   
    For intCharCodeCounter = LBound(strCharCodes) To UBound(strCharCodes)
        \' Denne del skal løbes igennem én gang for hver kode der skal ændres.
        intPosition = InStr(1, objTextBox.Text, strCharCodes(intCharCodeCounter)) \' Find næste kode
        While intPosition > 0 \' Så længe der bliver fundet flere koder.
            \' Koden udskiftes med den rette tekst
            strFoer = Left(objTextBox.Text, intPosition - 1)
            strEfter = Mid(objTextBox.Text, intPosition + Len(strCharCodes(intCharCodeCounter)))
            objTextBox.Text = strFoer & strCCText(intCharCodeCounter) & strEfter
            \' Der skal tages højde for at coursorens position forskydes hvis koden ikke har samme længde som den tekst der bliver indsat i stedet for koden.
            intStartPos = intStartPos + Len(strCCText(intCharCodeCounter)) - Len(strCharCodes(intCharCodeCounter))
            \' Find næste kode
            intPosition = InStr(1, objTextBox.Text, strCharCodes(intCharCodeCounter))
        Wend
    Next intCharCodeCounter
   
    \' Sæt courseren der hvor den var da vi startede.
    objTextBox.SelStart = intStartPos
    objTextBox.SelLength = intLength
End Sub