Ahmed mordy قام بنشر أبريل 14, 2018 مشاركة قام بنشر أبريل 14, 2018 السلام عليكم أرجو الأفادة أين يوضع هذا الكود 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 رابط هذا التعليق شارك More sharing options...
Eng Taha قام بنشر أبريل 14, 2018 مشاركة قام بنشر أبريل 14, 2018 alt +f11 insert module and paste it رابط هذا التعليق شارك More sharing options...
Ahmed mordy قام بنشر أبريل 14, 2018 الكاتب مشاركة قام بنشر أبريل 14, 2018 السلام عليكم مهندس طه اشكرك علي التفاعل ولكن انا لم اقوم بالتوضيح هذا الكود قسمين انا اوريد اضافة القسم الاول الي القسم الثاني من الكود الثاني رابط هذا التعليق شارك More sharing options...
Ahmed mordy قام بنشر أبريل 15, 2018 الكاتب مشاركة قام بنشر أبريل 15, 2018 للرفع رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.