سؤال لعباقرة الـ VBA بالمنتدى

[Hisham85]

السلام عليكم

عندى لووب متجدد بيجدد قيمة خلية بناء على قيمة متجددة للمتغير كالآتى
ActiveCell = ActiveCell & " " & MyVariable
المفروض بعد السطر ده بعمل فورمات معين للمتغير، لكن بيحصل بعد كده ان لما القيمة الجديدة تضاف، بترجع تلغى الفورمات للمتغير ده، وتدى الفورمات فقط للقيمة الجديدة للمتغير...

بمعنى ان المتغير فى البداية مثلا قيمته نَص وليكن 1 + 

بعدها بحط تحت النَص ده خط مثلا فبيكون كده 1 + .. ثم بعد كده اللوب بيجيب القيمة الجديدة للمتغير بتكون 2 +

فتصبح الخلية اللى انا واقف عليها = 1 + 2 + 

الخط يتحط للنص الثانى فقط ويتلغى من الأول .. حد عنده حل للمسألة ديه؟

 

تم تعديل مارس 21, 2018 بواسطه Hisham85

[سليم حاصبيا]

اضافة هذا السظر الى الكود

ActiveCell.Font.Underline = True

 

[Hisham85]

مشكور جدًا على ردك استاذ حسين

المفاجأة بقى

المتغير بتاعى عبارة عن

Characters 
بعينها داخل الخلية

هو عبارة عن "بسط" فى معادلة كبيرة بتتبنى باللووب 

والمطلوب فقط انى احط تحت الكراكترز دول خط

اللى بيحصل ان لما اللووب بتلف وتجيب (الجزء الجديد من المعادلة) عشان يُضاف على القديم

بتلغى الخطوط اللى كنت حطتها، ولما تيجى عند وضع خطوط للمتغير الجديد، بتضع خط تحت الجديد فقط وتترك القديم بدون خط

وهكذا، وفى نهاية المعادلة تكون كل المتغيرات (مكونات المعادلة) بدون خطوط

 

باستخراج المتغير الأول مثلا يكون هكذا 

 0.25 (542.3-289.6) +

المطلوب وضع خط تحت ما بين الأقواس لتصبح هكذا

 0.25 (542.3-289.6) +

عند تجدد قيمة المتغير تصبح قيمة المعادلة هكذا

0.25 (542.3-289.6) + 0.20 (250.8-173.6) +

ثم عند أخذ فورمات للكاراكترز الجديدة، تعطى فقط للجديدة لتصبح هكذا

0.25 (542.3-289.6) + 0.20 (250.8-173.6) +

ثم فى نهاية اللووب تختفى جميع الخطوط

الجزء الذى يتم إلغاء الفورمات فيه فى الكود هو التالى

ActiveCell = ActiveCell & Space(1) & MyVariable

يقوم بإلغاء تنسيق الخطوط السابق للكراكترز التى قمت بتنسيقها

هل من حل؟

تم تعديل مارس 21, 2018 بواسطه Hisham85

[سليم حاصبيا]

حيث انك لم ترفع ملفاً للعمل عليه

اليط هذا المثال الذي ربما تستطيع ان تقتبس منه ما يلزم

الكود

Option Explicit
Sub Under_line()
 Dim St$: St = [a1]
 Dim x%: x = Len(St)
 Dim t%, xx%
 Dim Op_Pos%, Cl_Pos%
 'Op_pos=Open parantheses position
 'Cl_pos=Close parantheses position
 '=============================
 [a1].Characters(1, Len([a1])).Font.ColorIndex = vbBlack
 [a1].Characters(1, Len([a1])).Font.Underline = False
 For t = 1 To 5000
  If t > x Then Exit For
   Op_Pos = InStr(t, St, "(")
   Cl_Pos = InStr(t, St, ")")
   If Op_Pos = 0 Then MsgBox "not Opened paranteses to work": Exit Sub
          xx = Cl_Pos - Op_Pos - 1
[a1].Characters(Op_Pos + 1, xx).Font.ColorIndex = 3
[a1].Characters(Op_Pos + 1, xx).Font.Underline = True
          t = 1 + Len(Mid(St, 1, Cl_Pos))
      Next
 End Sub
 '================================================
Sub remove_underline()
[a1].Characters(1, Len([a1])).Font.ColorIndex = vbBlack
 [a1].Characters(1, Len([a1])).Font.Underline = False
End Sub
'========================================

الملف مرفق

 

foermat between ().xlsm