مكان الكود ليعمل

[Ahmed mordy]

 

 

السلام عليكم  أرجو الأفادة أين يوضع هذا الكود

 

For ii = 0 To Frame1.ListCount – 1

'=======================================================================

TextBlock = Val(TextBlock) + Val(Format(Frame1.List(ii, 10), "0"))

TextPass.Value = Val(TextPass) + Val(Format(Frame1.List(ii, 9), "0"))

TextTotal.Value = Val(TextPass) + Val(TextBlock)

'================================================================

Next

'=======================================================================

TextBlock.Value = Format(TextBlock.Value, "###0")

TextPass.Value = Format(TextPass.Value, "###0")

TextTotal.Value = Format(TexTotal.Value, "###0")

'======================================================

 

 

فى هذا الكود

 

Option Explicit

'******************************************************

'******************************************************

'  اسم ورقة البيانات

Private Const Mysh_Name As String = "DATA"

'------------------------------------------------------

'  رقم عمود البحث

Private Const MyFind_Column As Integer = 2

'------------------------------------------------------

'  ارتفاع الكنترول

Private Const iHeight As Integer = 20

'******************************************************

 

 

'******************************************************

 

Private Sub kh_Find(MyText As String)

Dim MyHght, MyTp

Dim Last As Integer, ii As Integer, T As Integer

'===========================================

With Me.Frame1

    MyTp = .Controls(0).Top + .Controls(0).Height + 2

    T = .Controls.Count

End With

'===========================================

With Worksheets(Mysh_Name)

    Last = .Cells(.Rows.Count, MyFind_Column).End(xlUp).Row

    For ii = 2 To Last

        If CStr(.Cells(ii, MyFind_Column)) Like IIf(Me.Check_Text.Value, "", "*") & MyText & "*" Then

            MyHght = .Rows(ii).RowHeight

            If MyHght < iHeight Then MyHght = iHeight

            kh_Add_Controls Me.Frame1, MyTp, MyHght, .Cells(ii, MyFind_Column).Row, T

            MyTp = MyTp + MyHght + 2

        

        End If

    Next

End With

If MyTp >= Me.Frame1.Height Then Me.Frame1.ScrollHeight = MyTp

 

 

End Sub

 

Private Sub kh_Add_Controls(MyCont As Control, MyTop, MyHeight, iRo As Integer, MyCount As Integer)

'On Error Resume Next

Dim MyTxt As Control

Dim i As Integer

For i = 1 To MyCount

    Set MyTxt = MyCont.Add("Forms.TextBox.1", Cells(iRo, i).Address, True)

    With MyTxt

        .Move MyCont.Controls(i - 1).Left, MyTop, MyCont.Controls(i - 1).Width, MyHeight

        .MultiLine = True

        '===========================================

        .ControlSource = "'" & Mysh_Name & "'!" & Range(.Name).Address

        '===========================================

    End With

    '========================================

    With Worksheets(Mysh_Name).Cells(iRo, i)

        MyTxt.TextAlign = Me.kh_TextAlign(.HorizontalAlignment)

        MyTxt.Font.Bold = .Font.Bold

        MyTxt.Font.size = .Font.size

        MyTxt.FontName = .Font.Name

    End With

    

    '========================================

Next i

'==================

Set MyTxt = Nothing

'==================

'On Error GoTo 0

'===========================================

 

 

End Sub

 

Private Sub kh_Remove()

On Error Resume Next

Dim MyCon As Control

Me.Frame1.ScrollHeight = 0

For Each MyCon In Me.Frame1.Controls

    If TypeName(MyCon) = "TextBox" Then

        Me.Frame1.Controls.Remove MyCon.Name

        

    End If

Next MyCon

On Error GoTo 0

End Sub

 

 

Private Sub Button_Find_Click()

Dim WBK As Workbook

Set WBK = Workbooks.Open(ThisWorkbook.Path & "\daily Report.xlsb")

kh_Remove

If Len(Trim(Me.TextBox_Find.text)) Then

    kh_Find Me.TextBox_Find

 

    WBK.Close SaveChanges:=True

   

End If

 

 

End Sub

 

 

Private Sub CommandButton12_Click()

Shell "calc"

End Sub

 

Private Sub CommandButton2_Click()

Unload Me

End Sub

 

Private Sub Frame1_Click()

 

End Sub

 

Private Sub Label9_Click()

 

End Sub

 

Private Sub TextBox_Find_Change()

kh_Remove

End Sub

Function kh_TextAlign(MyAlign) As Integer

Dim Ag

Dim A As Integer

For A = 1 To 3

    Ag = Choose(A, -4131

[Eng Taha]

alt +f11 

insert module 

and paste it

[Ahmed mordy]

السلام عليكم 

مهندس طه اشكرك علي التفاعل ولكن انا لم اقوم بالتوضيح

هذا الكود قسمين انا اوريد اضافة القسم الاول 

الي القسم الثاني  من الكود الثاني

[Ahmed mordy]

للرفع