30-12-13, 06:08 PM
30-12-13, 09:22 PM
السلام عليكم...
نرجو الاستفادة و السلام.
كود :
Private ClnControlData As New Collection
Private Sub AddControlType(ByVal AControlType As String)
Dim ControlData(1 To 2) As String
Dim NewCount As Long
On Error GoTo AddControlType_Err
NewCount = CLng(ClnControlData(AControlType)(2)) + 1
ClnControlData.Remove AControlType
ControlData(1) = AControlType
ControlData(2) = CStr(NewCount)
ClnControlData.Add ControlData, AControlType
Exit Sub
AddControlType_Err:
Err.Clear
ControlData(1) = AControlType
ControlData(2) = "1"
ClnControlData.Add ControlData, AControlType
End Sub
Private Sub Command1_Click()
Dim Ctrl As Control
Dim CtrlType As String
Dim Idx As Long
Dim Msg As String
For Idx = 1 To ClnControlData.Count
ClnControlData.Remove 1
Next Idx
For Each Ctrl In Me.Controls
CtrlType = TypeName(Ctrl)
AddControlType CtrlType
Next
If ClnControlData.Count = 0 Then
MsgBox "لا توجد مكونات"
Else
Msg = ClnControlData(Idx)(1) & " = " & ClnControlData(Idx)(2)
For Idx = 2 To ClnControlData.Count
Msg = Msg & vbCrLf & ClnControlData(Idx)(1) & " = " & ClnControlData(Idx)(2)
Next Idx
MsgBox Msg
End If
End Sub
نرجو الاستفادة و السلام.
05-01-14, 12:30 AM
شكرا لك يامبدع