[تاج]

(30-12-15, 02:26 AM)Ahmed_Mansoor كتب : أهلا أخي الكريم ، جرب الكود التالي :

PHP كود :

Dim OrgLine As String
Dim TmpLine As String
Dim NewLine As String
Dim Lines_Array() As String
Dim Is_individual As Boolean
Dim LeftIndex As Integer
Dim RightIndex As Integer
Dim Lines_Count As Integer
Dim I As Integer

OrgLine = "2015"
TmpLine = OrgLine
LeftIndex = 1
RightIndex = Len(OrgLine)
Lines_Count = 1

IF Len(OrgLine) Mod 2 = 0 Then
    Is_individual = False
Else
  Is_individual = True
End IF

ReDim Lines_Array(1 To Lines_Count) As String

Lines_Array(Lines_Count) = OrgLine

Do

      IF LeftIndex = RightIndex Then
          IF Is_individual = True Then
              NewLine  = NewLine & Mid$(TmpLine,LeftIndex,1)
          End IF
          Lines_Count = Lines_Count + 1
          ReDim Preserve Lines_Array(1 To Lines_Count) As String
          Lines_Array(Lines_Count) = NewLine
          IF NewLine = OrgLine Then Exit Do
          TmpLine = NewLine
           NewLine = ""
           LeftIndex = 1
           RightIndex = Len(TmpLine)
      Else
          NewLine  = NewLine & Mid$(TmpLine,LeftIndex,1)
          NewLine  = NewLine & Mid$(TmpLine,RightIndex,1)
          LeftIndex = LeftIndex + 1
          RightIndex = RightIndex - 1
      End IF

Loop

For I = LBound(Lines_Array) To UBound(Lines_Array) 
      MsgBox Lines_Array(I)
Next 


ملاحظه : لم أجرب الكود لأني كتبته من الهاتف لكن إن شاء الله يعمل بشكل جيد

اخي احمد منصور
السلام عليكم ورحمة الله
اشكر لك اهتمامك باجابة اسئلتي
ولكن يظهر هذا الخطا باللون الاصفر
والبرنامج فى المرفقات

PHP كود :

NewLine = NewLine & Mid$(TmpLine, RightIndex, 1) 


---

(30-12-15, 05:16 AM)sami2015 كتب : Dim s$, i%, m$
s$ = "مرحبا"
m$ = m$ & s$ & vbCrLf
For i% = 1 To Len(s$)
   s$ = Mid$(s$, 2) & Mid$(s$, 1, 1)
   m$ = m$ & s$ & vbCrLf
Next
MsgBox m$

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