اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

السلام عليكم

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

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

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

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

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

 
تم تعديل بواسطه 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

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

هل من حل؟

تم تعديل بواسطه 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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information