نوشتن یکی در میان حروف

[hr0694]

سلام

برنامه ای رو میخام که سه تا تکست روی فرم داریم بعد من میخام در تکست اول حروف نوشته شود و در تکست دوم یک در میان حروف نوشته شود ابتدا حرف اول نوشته شود و در تکست سوم باز هم یک در میان حروف نوشته شود ایندفعه حرف دوم ابتدا نوشته شود
مثال
تکست1: "ا ل ب ی س ش" یا "البیسش"
تکست2: ا ب س ش ی ل (ابتدا حرف اول نوشته شود و وقتی به آخر حروف رسیدیم از آخر به اول می آییم)
تکست3: ب ش ل ی س ا (ابتدا حرف دوم نوشته شود و وقتی به آخر حروف رسیدیم از آخر به اول می آییم)

[MMR_1344]

برات یک قسمت رو نوشتم قسمت دوم رو خودت زحمت بکش بنویس

[hr0694]

دستتان درد نکند اما چرا وقتی بین حروف تکست1 فاصله میزارم تکست2 کار نمی کنه و اگه میشه قسمت دومش را هم خودتان الآن برام بنویسید من یه تازه کارم

Private Sub Command1_Click()
Dim a As String
Dim i As Integer, k As Integer
If Len(Text1) > 0 Then
a = ""
For i = 1 To Len(Text1) Step 2
a = a + Mid(Text1, i, 1)
Next
If Right(a, 1) = Right(Text1, 1) Then k = Len(Text1) - 1 Else k = Len(Text1)
For i = k To 1 Step -2
a = a + Mid(Text1, i, 1)
Next
Text2 = a
End If
End Sub
Private Sub Form_Load()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub

[hr0694]

کسی نیست به این سؤال پاسخ بده

[محسن واژدی]

سلام عليکم
بااجازه MMR_1344 عزيز، کد زير (ويرايش پست2) را جايگزين Form1 موجود در ضميمه پست 2 کنيد:

Option Explicit

Private Sub Command1_Click()
Text2 = Selection$(Text1, 1)
Text3 = Selection$(Text2, 2)
End Sub

Private Sub Form_Load()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub

Function Selection$(ByVal tText$, iFirstTextNum%)
Dim a As String
Dim i As Integer, k As Integer
tText$ = Replace(tText$, " ", "")
If Len(tText$) > 0 Then
a = ""
For i = iFirstTextNum% To Len(tText$) Step 2
a = a + Mid(tText$, i, 1)
Next
If Right(a, 1) = Right(tText$, 1) Then k = Len(tText$) - 1 Else k = Len(tText$)
For i = k To 1 Step -2
a = a + Mid(tText$, i, 1)
Next
Selection$ = a
End If
End Function


موفق باشيد