اذهب الي المحتوي
أوفيسنا

Ahmed mordy

02 الأعضاء
  • Posts

    58
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

3 Neutral

عن العضو Ahmed mordy

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    Quality control
  • البلد
    Eegypt
  • الإهتمامات
    الرياضه

اخر الزوار

بلوك اخر الزوار معطل ولن يظهر للاعضاء

  1. السلام عليكم ارجو من السادة الافاضل تعديل على الكود المرفق فى الملف بحيث اضغط على أي خلية ملونة باللون الاخضر ستظهر لك كمبوبكس اريد تعديل على الكود بحيث عند كتابة رقم فى الكمبوبوكس يعمل جمع على الرقم الموجود فى الخلية ولا يقوم بحذف الرقم الموجود فى الخلية وينطبق هذا على العمود A كله ولكم جزيل الشكر texte prédictive 2007.rar
  2. السلام عليكم كل عام وانتم بخير ما هو الحل فى البيانات تظهر في list box مرة يمين و مرة شمال واريدها تظهر فى اتجاه واحد ولكم الشكر
  3. السلام عليكم تحياتي للاستاذ الكبير عبد الله بقشير بارك الله فيك وجعله في ميزان حسناتك عمل رائع هل من الممكن اضافة جمع عمودين في لليست بوكس وتظهر النتائج في تكست بوكس لكل عمود ولك جزيل الشكر
  4. السادة خبراء المنتدي ارجو المساعدة في المطلوب هل انا مش قادر اوصل المطلوب ولا المطلوب صعب بس انا استبعد ان المطلوب صعب لان خبراء المنتدي لا يستصعب عليهم امرا ان شاءالله
  5. السلام عليكم مهندس طه اشكرك علي التفاعل ولكن انا لم اقوم بالتوضيح هذا الكود قسمين انا اوريد اضافة القسم الاول الي القسم الثاني من الكود الثاني
  6. السلام عليكم أرجو الأفادة أين يوضع هذا الكود 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
  7. السلام عليكم كل عام وانتم بخير كيف يتم جمع عمود في ListBox1 وتظهر النتيجة في TextBox1 وجمع محتوي TextBox1 و TextBox2 ولكم الشكر
  8. السلام عليكم كل عام وانتم بخير كيف يتم جمع عمود في ListBox1 وتظهر النتيجة في TextBox1 وجمع محتوي TextBox1 و TextBox2 ولكم الشكر
  9. السادة الافاضل هذا الكود يتعارض مع اوفيس 2016 حتي بعد اضافة دالة ptrsafe ارجو الافادة وما هو الحل بارك الله فيكم Option Explicit '//////////////////////////////////////////////////////////////////// 'Password masked inputbox 'Allows you to hide characters entered in a VBA Inputbox. ' 'Code written by Daniel Klann 'March 2003 '//////////////////////////////////////////////////////////////////// 'API functions to be used Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) ! InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook End Function
×
×
  • اضف...

Important Information