تغيير لغة البرنامج من عربي الى انكليزي لكن من دون تغيير عرض النموذج من اليسار الى اليمين

[iyad mohamad]

السلام عليكم ورحمة الله وبركاته 

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

ولكم جزيل الشكر

وهذا هو الموديول

Option Explicit

Private Sub NewSource(Ctl As Control)
  Dim OldSource As String
  Dim InSource As String
  Dim Parts(1 To 4) As String
  Dim Part As Byte
  Dim Pos As Integer
  
  If Ctl.RowSourceType <> "Table/Query" Then Exit Sub
  If Ctl.ColumnCount < 3 Then Exit Sub
  
  InSource = Ctl.RowSource
  If InSource = "" Or Left(InSource, 7) <> "SELECT " Then
    Exit Sub
  End If
  
  Pos = InStr(1, InSource, " FROM")
  Parts(4) = Mid(InSource, Pos, Len(InSource))
  OldSource = Left(InSource, Pos - 1) & ","
  
  For Part = 1 To 3
    Pos = InStr(1, OldSource, ",")
    If Pos > 0 Then
      Parts(Part) = CStr(Left(OldSource, Pos))
      OldSource = Mid(OldSource, Pos + 1, Len(OldSource))
    End If
  Next Part
  
  If Right(OldSource, 1) = "," Then
    OldSource = Left(OldSource, Len(OldSource) - 1)
  Else
    If OldSource = "" Then Parts(2) = Left(Parts(2), Len(CStr(Parts(2))) - 1)
  End If
  
  Ctl.RowSource = Parts(1) & Parts(3) & Parts(2) & OldSource & Parts(4)
End Sub

Private Sub NewValueList(Ctl As Control)
  Dim OldSource As String
  Dim NewSource As String
  Dim TempStr As String
  Dim Part As Byte
  Dim Cols As Byte
  Dim ColLen As Double
  Dim Pos As Integer
  Dim Count As Integer
  
  If Ctl.RowSourceType <> "Value List" Then Exit Sub
  If Ctl.ColumnCount < 3 Then Exit Sub
  
  OldSource = Ctl.RowSource & ";"
  Cols = Ctl.ColumnCount
  
  Do
    Pos = InStr(Pos + 1, OldSource, ";")
    If Pos > 0 Then Count = Count + 1
  Loop Until Pos = 0
  If Count < Cols * 3 Then Exit Sub
  ColLen = Count / Cols
  If ColLen <> Fix(ColLen) Then Exit Sub
  
  For Part = 1 To Cols
    For Count = 1 To ColLen
      Pos = InStr(1, OldSource, ";")
      If Pos > 0 Then
        Select Case Count
          Case 2
            TempStr = Left(OldSource, Pos)
          Case 3
            NewSource = NewSource & Left(OldSource, Pos) & TempStr
          Case Else
            NewSource = NewSource & Left(OldSource, Pos)
        End Select
        OldSource = Mid(OldSource, Pos + 1)
      End If
    Next Count
  Next Part
  
  NewSource = Left(NewSource, Len(NewSource) - 1)
  Ctl.RowSource = NewSource
  Ctl.Requery
End Sub

Private Sub ChangeColumnOrder(eMe As Object)
  Dim Cols
  Dim Ctrl As Control
  Dim Ctrls As Long
  Dim Count As Integer
  
  On Error Resume Next
  
  If eMe.DefaultView <> 2 Then Exit Sub
  ReDim Cols(1 To eMe.Controls.Count) As String
  
  For Each Ctrl In eMe.Controls
    With Ctrl
      If .Section = 0 Then
        If .ControlType <> acLabel Then
          Count = Count + 1
          Cols(.ColumnOrder) = .Name
        End If
      End If
    End With
  Next
 
  If Count < 2 Then Exit Sub
  Ctrls = Count
  
  For Count = 1 To Ctrls
    eMe(Cols(Count)).ColumnOrder = Ctrls - eMe(Cols(Count)).ColumnOrder - Count
  Next Count
End Sub

Sub ChangeOrientation(eMe As Object)
  Dim Ctl As Control
  Dim GrpLeft() As Integer
  Dim GrpWidth() As Integer
  Dim GrpCtl() As Control
  Dim Count As Byte
  Dim Ctrls As Byte
  Dim FormWidth As Integer
  Dim TempCaption As String
  Dim Test As Variant
  
  On Error Resume Next
  
  For Each Ctl In eMe.Controls
    With Ctl
      If .ControlType = acOptionGroup Then
        Count = Count + 1
        ReDim Preserve GrpCtl(Count)
        ReDim Preserve GrpLeft(Count)
        ReDim Preserve GrpWidth(Count)
        Set GrpCtl(Count) = Ctl
        GrpLeft(Count) = .Left
        GrpWidth(Count) = .Width
      End If
    End With
  Next Ctl
  FormWidth = eMe.Width
  
  With eMe
    If Trim(.Tag) <> "" And Trim(.Caption) <> "" Then
      TempCaption = .Caption
      .Caption = .Tag
      .Tag = TempCaption
    End If
  End With
  
  For Each Ctl In eMe.Controls
    With Ctl
      If .ControlType <> acOptionGroup Then
         If .ControlType <> 124 Then
           .Left = FormWidth - (.Left + .Width)
         End If
        '------------------
        If .ControlType = acComboBox Or _
           .ControlType = acListBox Then
          Call NewSource(Ctl)
          Call NewValueList(Ctl)
          Select Case .ScrollBarAlign
            Case 1: .ScrollBarAlign = 2
            Case 2: .ScrollBarAlign = 1
          End Select
        End If
        '------------------
        Select Case .Format
          Case "dd/mm/yy":   .Format = "yy/mm/dd"
          Case "dd-mm-yy":   .Format = "yy-mm-dd"
          Case "dd/mm/yyyy": .Format = "yyyy/mm/dd"
          Case "dd-mm-yyyy": .Format = "yyyy-mm-dd"
          Case "yy/mm/dd":   .Format = "dd/mm/yy"
          Case "yy-mm-dd":   .Format = "dd-mm-yy"
          Case "yyyy/mm/dd": .Format = "dd/mm/yyyy"
          Case "yyyy-mm-dd": .Format = "dd-mm-yyyy"
        End Select
        '------------------
        Select Case .NumeralShapes
          Case 1: .NumeralShapes = 2
          Case 2: .NumeralShapes = 1
        End Select
        '------------------
        Err.Clear
        Test = .Caption
        If Err.Number = 0 Then
          If Trim(.Tag) <> "" And Trim(.Caption) <> "" Then
            TempCaption = .Caption
            .Caption = .Tag
            .Tag = TempCaption
          End If
        End If
        '------------------
        Select Case .TextAlign
          Case 1: .TextAlign = 3
          Case 3: .TextAlign = 1
        End Select
        '------------------
        'If .ControlType = acLine Then
          .LineSlant = -(.LineSlant + 1)
        'End If
        '------------------
        If .ControlType = acSubform Then
          If .Tag <> "No Change" Then Call ChangeOrientation(.Form)
        End If
        '------------------
        If .ControlType = acTabCtl Then
          Ctrls = .Pages.Count
          If Ctrls > 1 Then
            For Count = 0 To Ctrls - 2
              .Pages(Count).PageIndex = (Ctrls - 1) - .Pages(Count).PageIndex - Count
            Next Count
          End If
        End If
      End If
    End With
  Next Ctl
  
  If UBound(GrpCtl) = -1 Then GoTo ExitSub
  '------------------
  For Count = 1 To UBound(GrpCtl)
    GrpCtl(Count).Move FormWidth - (GrpLeft(Count) + GrpWidth(Count)), , _
                       GrpWidth(Count)
    eMe.Width = FormWidth
  Next Count

ExitSub:
  Call ChangeColumnOrder(eMe)
End Sub
 

[Foksh]

انتظرني غداً إن شاء الله بموضوع تغيير اللغة بطريقة جميلة وإن شاء الله تسمح الظروف بذلك 😉

[kkhalifa1960]

اذهب لهذه المشاركة .