جمع ارقام یک عدد و دو مختلف سؤال دیگر

[Hassan2500]

سلام
چندتا سؤال داشتم
1- کدی میخام که ارقام یک عدد را تا جائی با هم جمع کند که عدد یک رقمی شود مثال 159 بشود 1+5+9=15 بعد 5+1=6

2- چکار کنم که تکست1 که مولتی لاین آن True است هیچ وقت تعداد خطهایش هنگام نوشتن و پیست کردن بیشتر از دو تا نشود و فقط بتوان دو خط در آن نوشت یا پیست شود.

3- من میخام این دو خط کد بصورت یک خط کد درآید.
If Text1 = "" Then Text2 = ""
و
If Text1 = "" Then Text3 = ""

[SlowCode]

جواب سوال اول:
a = 15
s = 0
Z:
For i = 1 To Len(a)
s = s + Mid(a, i, 1)
Next
If Len(s) > 1 Then GoTo Z
MsgBox s
عدد دلخواهتون رو توی a قرار بدین.

[Hassan2500]

اگه میشه بصورت دو تکست که در اولی عدد وارد بشه و در دومی جمع ارقام آن آورده شود برام این کدتون رو ویرایش کنید

[SlowCode]

بفرما
a = text1.text
s = 0
Z:
For i = 1 To Len(a)
s = s + Mid(a, i, 1)
Next
If Len(s) > 1 Then GoTo Z
text2.text = s



بهتر بود این کار رو خودتون میکرید.

[SlowCode]

جواب سوال 3:
If Text1="" Then Text2="" : If text1="" Then Text3=""

[Hassan2500]

جناب محسن 15 ابتدا بگم من در برنامه نویسی مبتدی هستم در ضمن این کد شما کار نمیکنه یعنی عددی که جمع ارقام آن در مرحله اول تک رقمی باشد را درست محاسبه میکند مثل 23 اما برای اعدادی مثل 99 کار نمیکنه اگه میشه کاملش کنید

[SlowCode]

ببینید درست کار میکنه یا نه:
a = text1.text
Z:
s = 0
For i = 1 To Len(a)
s = s + Mid(a, i, 1)
Next
If Len(s) > 1 Then a=s : GoTo Z
text2.text = s

[Hassan2500]

درست شد کارت بیسته

[MohammadGh2011]

سلام عليکم

2- چکار کنم که تکست1 که مولتی لاین آن True است هیچ وقت تعداد خطهایش هنگام نوشتن و پیست کردن بیشتر از دو تا نشود و فقط بتوان دو خط در آن نوشت یا پیست شود.
با کد زير ميتونيد تعداد کاراکتري که در تکست يک وارد ميشه رو تنظيم کنيد
Private Sub Form_Load()
Text1.SelLength = 10
End Sub

موفق باشيد

[Hassan2500]

منظورم اینه که اگه فوکوس در هنگام نوشتن به آخر تکست رسید دیگه هیچی نوشته نشه منتها این حالت برای دو خط باشه یعنی فوکوس در آخر خط دوم باشه حالا اگه هر اندازه ای طول تکست باشه این حالت براش رعایت بشه و در مورد پیست کردن هم اگه چند خط رو پیست میکنیم فقط دو خط اولی گذاشته بشه

[SlowCode]

شما بررسی کن اگه بیش از 2 تا vbcrlf(سرخط) باشه بقیه رو پاک کنه.

[Hassan2500]

لطفاً کدش رو برام بنویسید

[ASedJavad]

منظورت از دو خط دو تا پاراگرافه یا نه.
یعنی فرض کنیم کاربر یه متن طولانی می نویسه ولی توش یه بار هم اینتر نمی زنه. حالا اگه اونو ببریم تو تکست باکس با این که در اصل یه خط محسوب میشه ولی تو تکست باکس چند خط نشون داده میشه.
در این حالت این یه خط محسوب بشه یا چند خط؟

[ASedJavad]

a = text1.text
Z:
s = 0
For i = 1 To Len(a)
s = s + Mid(a, i, 1)
Next
If Len(s) > 1 Then a=s : GoTo Z
text2.text = s



دوست عزیز
سعی کنید بجای goto های اینچنینی تا حد امکان از حلقه های do استفاده کنید.
به نظر بهینه تر هستن

[Hassan2500]

چند خط محسوب بشه بعد جناب ASedJavad براتون یه پیام خصوصی فرستادم اگه میشه جوابش رو هم خصوصی برام بفرستید.

[ASedJavad]

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_LINEINDEX = &HBB

Private Sub Text1_Change()
Dim a As Long, x As Long
x = Text1.SelStart
a = SendMessage(Text1.hwnd, EM_LINEINDEX, 2, ByVal 0&)
If a > 0 Then Text1.Text = Left$(Text1.Text, a): Text1.SelStart = x
End Sub


این کد راه حل کلی رو دستتون میده که البته یه سری ایراداتی داره که بر حسب نیازتون باید ایراداتش رو برطرف کنید

[ASedJavad]

وقتی دو خط در تکست1 نوشته میشود و وسط حروف نوشته شده چه با فاصله و بدون فاصله حرفی مینویسیم یا دکمه فاصله را میزنیم حروف بعد فوکوس پاک میشوند من میخام هیچ تغییری نکنند و دیگر وقتی تکست1 پر شد هیچ حرفی دیگر نوشته نشود و دکمه فاصله از کار بیفتد مگر اینکه حرفی را پاک کنیم
این که Text1 پر شد، یه چیز نسبیه.
شما ممکنه اگه توتکستباکستون یه w تایپ کنید، جا نشه (بره خط بعد) اما دو تا l بتونید تایپ کنید بدون اینکه بره خط بعد.
در مورد حروف فارسی هم همین طوره مثلا شما ب رو با ا مقایسه کن.
اما میشه یه کار کرد، هر وقت حرفی یا فاصله ای یا هر چیز دیگه ای به تکست باکست اضافه شد، اون قدر از آخر متنت حذف کنی تا دوباره دو خط بشه.
این کار ظاهرا یخورده از کد قبلی که گذاشتم بهتره:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_LINEINDEX = &HBB
Private Sub Text1_Change()
Static z As Boolean
If Not z Then
Dim a As Long, x As Long
x = Text1.SelStart
z = True
Do While SendMessage(Text1.hwnd, EM_LINEINDEX, 2, ByVal 0&) > 0

Text1.Text = Left$(Text1.Text, Len(Text1.Text) - 1)
Loop
Text1.SelStart = x
z = False
End If
End Sub


البته شاید بشه یه کارای دیگه هم کرد که بستگی به نیازت داره