IncrString




Private Sub Command1_Click()
thetext = Text1.Text
incremnttxt = findchr(thetext)
Text2.Text = incremnttxt
End Sub

Function findchr(ByVal thetext As String)
Dim strlen As Integer
Dim A1() As String
strlen = Len(thetext) ' number of characters
ReDim A1(strlen)

For L = 1 To UBound(A1)' parse individual characters
A1(L) = Mid(thetext, L, 1)
Next L

For nxtchar = 1 To UBound(A1)' cyle through characters increment ascii value
valchar = (UBound(A1)) - (nxtchar - 1)
If Asc(A1(valchar)) >= 65 And Asc(A1(valchar)) <= 90 Or _
'upper and lower alpha characters

Asc(A1(valchar)) >= 97 And Asc(A1(valchar)) <= 122 Then
If Asc(A1(valchar)) = 90 Or Asc(A1(valchar)) = 122 Then
If Asc(A1(valchar)) = 90 Then
If valchar = 1 Then ' fisrt char at the End of ascii list
A1(valchar) = "AA"
Else
A1(valchar) = "A"
End If
Else
If valchar = 1 Then ' fisrt char at the End of ascii list
A1(valchar) = "aa"
Else
A1(valchar) = "a"
End If
End If
Else
A1(valchar) = Chr(Asc(A1(valchar)) + 1) ' increment ascii by one
Goto noneedto:
End If

ElseIf Asc(A1(valchar)) > 47 And Asc(A1(valchar)) < 58 Then 'numeric values

If Asc(A1(valchar)) = 57 Then
If valchar = 1 Then ' fisrt char at the End of ascii list
A1(valchar) = "10"
Else
A1(valchar) = "0"
End If
Else
A1(valchar) = Chr(Asc(A1(valchar)) + 1) ' increment ascii by one
Goto noneedto:
End If
End If

Next nxtchar

'noneedto: 'once a char is increment and is Not carried over no

'need to increment all chars


For mke = LBound(A1) To UBound(A1) ' make text
findchr = Trim$(findchr) & A1(mke)
Next mke
End Function
Assumes:

Add two text boxes and a
command button to a form.










( incrstring.html )- by Paolo Puglisi - Modifica del 17/12/2023