[حل شده] فرمت درصد برای TextBox

[golchehre]

سلام میخوام یک TextBox رو از یک شیت (در فایل ضمیمه شیت2) به سلولی در شیت دیگر که فرمت آن درصد میباشد (در فایل ضمیمه شیت1) لینک کنم چطور میتونم فرمت نمایش TextBox را به صورت درصد کنم به نحوی که دقیقا همان چیزی که در سلولB2 در شیت1 دیده میشود در TextBox هم دیده شود یعنی به صورت علامت درصد دار نه ممیز دار
یه نمونه کد هم برای این کار پیدا کردم و داخل شیت2 نوشتم ولی ارور میده
یه مشکل دیگه هم که دارم با اینکه فونت TextBox را b Titr گذاشتم ولی فونت نمایش داده شده در TextBox فقط در اعداد منفی اعمال شده و در اعداد مثبت با فونت دیگری نمایش میده (کلا فونت نمایش TextBox لینک شده درست نمایش داده نمیشه ) باید با دستور vba فونت TextBox را اعمال کنم؟

[Amir Ghasemiyan]

سلام دوست عزيز

براي سوال اولتون اين كدها رو جايگزين كدهاي اسپين كنيد:

Private Sub SpinButton1_SpinDown()
 TextBox1.Value = (Val(Left(TextBox1.Value, Len(TextBox1.Value) - 1)) - 1) / 100
 TextBox1.Value = Format(TextBox1.Value, "#%")
End Sub


Private Sub SpinButton1_SpinUp()
  TextBox1.Value = (Val(Left(TextBox1.Value, Len(TextBox1.Value) - 1)) + 1) / 100
  TextBox1.Value = Format(TextBox1.Value, "#%")
End Sub

براي سوال دومتون هم بررسي ميكنم اگه به نتيجه اي رسيدم عرض ميكنم

[golchehre]

سلام دوست عزيز

براي سوال اولتون اين كدها رو جايگزين كدهاي اسپين كنيد:

Private Sub SpinButton1_SpinDown()
 TextBox1.Value = (Val(Left(TextBox1.Value, Len(TextBox1.Value) - 1)) - 1) / 100
 TextBox1.Value = Format(TextBox1.Value, "#%")
End Sub


Private Sub SpinButton1_SpinUp()
  TextBox1.Value = (Val(Left(TextBox1.Value, Len(TextBox1.Value) - 1)) + 1) / 100
  TextBox1.Value = Format(TextBox1.Value, "#%")
End Sub

براي سوال دومتون هم بررسي ميكنم اگه به نتيجه اي رسيدم عرض ميكنم

خیلی لطف کردید جناب قاسمیان کد اسپین در شیت 1 هم باید عوض کنیم؟ چون با عوض شدن کد اسپین در شیت2 ؛ تو شیت 1 ارور میده و اینکه تو تکست باکس درصد 0 نمایش داده نمیشه
سوال دوم اگه بخوایم دستی عدد وارد تکست باکس کنیم (از اسپین استفاده نکنیم) چطور مشکل حل میشه

[Amir Ghasemiyan]

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

خواهش ميكنم

كل اين كدها رو جايگزين بفرماييد. هر دو مشكلتون رفع ميشه

Private Sub SpinButton1_SpinDown()
 TextBox1.Value = (Val(Right(TextBox1.Value, Len(TextBox1.Value) - 1)) - 1)
 TextBox1.Value = "%" & TextBox1.Value
End Sub


Private Sub SpinButton1_SpinUp()
  TextBox1.Value = (Val(Right(TextBox1.Value, Len(TextBox1.Value) - 1)) + 1)
  TextBox1.Value = "%" & TextBox1.Value
End Sub


Private Sub TextBox1_LostFocus()
    Dim xReg As New RegExp
    Dim xMatches As MatchCollection
    Dim xMatch As Match
    Dim xText As String
    Dim xReplace As String
    On Error Resume Next
    Application.ScreenUpdating = False
    xText = Me.TextBox1.Text
    xText = Replace(xText, "%", "")
    With xReg
        .Global = True
        .Pattern = "([^0-9]+\d+)|(\d{1,})"
        Set xMatches = .Execute(xText)
        For Each xMatch In xMatches
            xReplace = xReplace & "%" & xMatch.Value
        Next
    End With
    xText = xReplace & Mid(xText, Len(xReplace) - xMatches.Count + 1)
    Me.TextBox1.Text = xText
    Application.ScreenUpdating = True
End Sub

[golchehre]

خواهش ميكنم

كل اين كدها رو جايگزين بفرماييد. هر دو مشكلتون رفع ميشه

Private Sub SpinButton1_SpinDown()
 TextBox1.Value = (Val(Right(TextBox1.Value, Len(TextBox1.Value) - 1)) - 1)
 TextBox1.Value = "%" & TextBox1.Value
End Sub


Private Sub SpinButton1_SpinUp()
  TextBox1.Value = (Val(Right(TextBox1.Value, Len(TextBox1.Value) - 1)) + 1)
  TextBox1.Value = "%" & TextBox1.Value
End Sub


Private Sub TextBox1_LostFocus()
    Dim xReg As New RegExp
    Dim xMatches As MatchCollection
    Dim xMatch As Match
    Dim xText As String
    Dim xReplace As String
    On Error Resume Next
    Application.ScreenUpdating = False
    xText = Me.TextBox1.Text
    xText = Replace(xText, "%", "")
    With xReg
        .Global = True
        .Pattern = "([^0-9]+\d+)|(\d{1,})"
        Set xMatches = .Execute(xText)
        For Each xMatch In xMatches
            xReplace = xReplace & "%" & xMatch.Value
        Next
    End With
    xText = xReplace & Mid(xText, Len(xReplace) - xMatches.Count + 1)
    Me.TextBox1.Text = xText
    Application.ScreenUpdating = True
End Sub

تشکر از شما ولی همین کد رو تو فایل پیوست قبلا اضافه کرده بودم و اروری که تو عکس زیر پیوست میکنم رو میده
جناب قاسمیان کد اسپین در شیت 1 هم باید عوض کنیم؟ چون با عوض شدن کد اسپین در شیت2 ؛ دستور اسپین تو شیت 1 ارور میده

[Amir Ghasemiyan]

تشکر از شما ولی همین کد رو تو فایل پیوست قبلا اضافه کرده بودم و اروری که تو عکس زیر پیوست میکنم رو میده
جناب قاسمیان کد اسپین در شیت 1 هم باید عوض کنیم؟ چون با عوض شدن کد اسپین در شیت2 ؛ دستور اسپین تو شیت 1 ارور میده

دوست عزيز كل كدهايي كه تقديم كردم رو با كدهاي خودتون جايگزين كنيد. درضمن چون از كتابخانه regexp استفاده كرديد بايد كتابخانه مربوطه رو فعال كنيد (علت خطاي اول اين هست)
هيچ تغييري در اسپين ها و يا موارد ديگه نياز نيست بديد. فقط كدها رو جايگزين كنيد و كتابخانه را فعال كنيد

[golchehre]

دوست عزيز كل كدهايي كه تقديم كردم رو با كدهاي خودتون جايگزين كنيد. درضمن چون از كتابخانه regexp استفاده كرديد بايد كتابخانه مربوطه رو فعال كنيد (علت خطاي اول اين هست)
هيچ تغييري در اسپين ها و يا موارد ديگه نياز نيست بديد. فقط كدها رو جايگزين كنيد و كتابخانه را فعال كنيد

ممنون از راهنمایی شما مشکل از کتابخانه Microsoft VBScript Regular Expressions 5.5 بود ولی وقتی در شیت 2 با اسپین مقدار میدم و بعدش برم در شیت 1 با اسپین مقدار بدم ارور زیر رو میده نمیدونم مشکل از کجاست
Run-time error '13':
Type mismatch
فایل رو پیوست میکنم ممنون میشم بررسی کنید تشکر از زحمات شما

[Amir Ghasemiyan]

ممنون از راهنمایی شما مشکل از کتابخانه Microsoft VBScript Regular Expressions 5.5 بود ولی وقتی در شیت 2 با اسپین مقدار میدم و بعدش برم در شیت 1 با اسپین مقدار بدم ارور زیر رو میده نمیدونم مشکل از کجاست
Run-time error '13':
Type mismatch
فایل رو پیوست میکنم ممنون میشم بررسی کنید تشکر از زحمات شما

شما کدهای شیت دوم رو درست کردین اما شیت اول رو درست نکردید.
کدهای شیت اول رو به این صورت اصلاح کنید

Private Sub SpinButton1_SpinDown()
 Sheet2.TextBox1.Value = (Val(Left(Sheet2.TextBox1.Value, Len(Sheet2.TextBox1.Value) - 1)) - 1)
  Sheet2.TextBox1.Value = Sheet2.TextBox1.Value & "%"
End Sub




Private Sub SpinButton1_SpinUp()
  Sheet2.TextBox1.Value = (Val(Left(Sheet2.TextBox1.Value, Len(Sheet2.TextBox1.Value) - 1)) + 1)
  Sheet2.TextBox1.Value = Sheet2.TextBox1.Value & "%"
End Sub

[golchehre]

شما کدهای شیت دوم رو درست کردین اما شیت اول رو درست نکردید.
کدهای شیت اول رو به این صورت اصلاح کنید

Private Sub SpinButton1_SpinDown()
 Sheet2.TextBox1.Value = (Val(Left(Sheet2.TextBox1.Value, Len(Sheet2.TextBox1.Value) - 1)) - 1)
  Sheet2.TextBox1.Value = Sheet2.TextBox1.Value & "%"
End Sub




Private Sub SpinButton1_SpinUp()
  Sheet2.TextBox1.Value = (Val(Left(Sheet2.TextBox1.Value, Len(Sheet2.TextBox1.Value) - 1)) + 1)
  Sheet2.TextBox1.Value = Sheet2.TextBox1.Value & "%"
End Sub

با تشکر از لطف شما کد شیت 1 هم طبق گفته شما عوض کردم ولی یه مشکلی پابرجاست اینکه در شیت یک وقتی به صورت دستی مقدار مثلا 55 درصد را میدم و الباقیش را با اسپین باتن بخوام کم یا زیاد کنم مقدار 55 تبدیل به اعشار میشه مثلا میشه 1.5 ، 2.5 ، 3.5 و تا اخر این اعشار باقی میمونه

[Amir Ghasemiyan]

با تشکر از لطف شما کد شیت 1 هم طبق گفته شما عوض کردم ولی یه مشکلی پابرجاست اینکه در شیت یک وقتی به صورت دستی مقدار مثلا 55 درصد را میدم و الباقیش را با اسپین باتن بخوام کم یا زیاد کنم مقدار 55 تبدیل به اعشار میشه مثلا میشه 1.5 ، 2.5 ، 3.5 و تا اخر این اعشار باقی میمونه

دو تا كار بايد انجام بديد:
1- فرمت سلول B2 رو text كنيد
2- اين كد رو به شيت 1 اضافه كنيد

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("B2") = Range("B2") & "%"
Application.EnableEvents = True
End Sub

[golchehre]