خالد حرب

السلام عليكم اشكركم على الردود سادتي الافاضل حتى تكون الصورة واضحة لديكم و ما عجزت عن تحقيقه . الجدول الاول :- اسمه (Shipname) ( اسماء السفن ) يحتوي على حقلين 1_ ID ترقيم تلقائي 2_ shipName نص مختصر الجدول الثاني :- اسمه (vesselINwharf) ( الارساء ) يحتوي على 1_ ID ترقيم تلقائي 2_ shipName رقم و عدة حقول اخرى مثل التاريخ و الساعة ** يضاف اسم السفينة في الجدول الثاني (vesselINwharf) من جدول الاول (Shipname) الى هذه النقطة كل شي تمام تم انشاء جدول جديد الثالث اسمه (daleywork) الغرض منه ادخال الاعمال اليومية للسفن الراسية يحتوي على 1_ ID 2_ NameShip و عدة حقول اخرى مثل التاريخ و الساعة و اهمها حقل نعم/لا المطلوب الاتي عند فتح نموذج ادخال البيانات لهذا الجدول اتحصل على الاتي 1_ عند فتح القائمة المنسدلة لاسم السفينة تضهر لي باسماء السفن الموجودة بالجدول (vesselINwharf) و تستمر في الضهور الى ان يتم وضع علامة نعم 2_ عند وضع علامة نعم لا يضهر اسم السفينة في الجدولين (vesselINwharf) و (daleywork)

السلام عليكم ما هي الصغة التي اضعها في المعيار لعدم التكرار

السلام عليكم جميعا اخوتي الاكارم ارغب في ترحيل البيانات من جدول مؤقت الى جدول اساسى على ان يتم الترحيل عند ادخال تاريخ في حقل محدد . ارجو افادتي

السادة الافاضل لا استطيع فتح لمفات الاكسل الموجودة لذي في جهاز الكمبيوتر فهي تظهر باللون الرمادي بدون اي بيانات كما باصورة المرفقة ولكن عند فتح احد هذه الملفات من داخل الاكسل في (قائمة ملف )تم (فتح) فانها تفتح ارجو الافادة

السادة عبدالله الصادي هاني علي اشكركم علي كل ما بدلتموه من مجهود و للاسف لم اتمكن من فتح الملف

ارفق اليكم الملف لاجاء التعديلات اذا امكن برنامج صلاحيات المستخدمين اصدار .xlsm

السلام عليكم شكرا استاد عبدالله على الرد اخي الكريم تم وضع " PtrSafe " كما تفظلت و لكن اصبحنا في هذا الخطأ فما هو الحل في وجهة نظرك

السلام عليكم ما هو الخطأ في هذا الكود علما بان هذا الكود يشتغل على اوفس 2010 و عند نقل الملف على اوفس 2013 يظهر هذا الخطأ Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Dim hWnd As Long: Const GWL_STYLE = -16: Const WS_SYSMENU = &H80000 Dim AA As Integer Dim Tx_1() As New Ali_Pass_Num Private Sub CommandButton5_Click() UserForm2.Show End Sub Private Sub CommandButton6_Click() UserForm5.Show End Sub Private Sub UserForm_Deactivate() End Sub Private Sub UserForm_Initialize() Dim t As Integer, hWnd As Long, lStyle As Long: hWnd = FindWindow("ThunderDFrame", Me.Caption): SetWindowLong hWnd, GWL_STYLE, (lStyle And Not WS_SYSMENU) Dim A_TCoun As Integer, Ct A_TCoun = 0 For Each Ct In Array("TextBox1", "TextBox4") A_TCoun = A_TCoun + 1 ReDim Preserve Tx_1(1 To A_TCoun) Set Tx_1(A_TCoun).A_Tx_1 = Me.Controls(Ct) Next Ct t = 4 Do ComboBox1.AddItem Sheets("MyDate").Cells(t, 1) t = t + 1 Loop Until Sheets("MyDate").Cells(t, 1) = "" Me.Label1.Caption = Sheets("MyDate").Cells(3, 1) Me.Label2.Caption = Sheets("MyDate").Cells(3, 2) Me.Label3.Caption = Sheets("MyDate").Cells(3, 1) Me.Label4.Caption = Sheets("MyDate").Cells(3, 2) End Sub Private Sub ComboBox1_Change() TextBox1 = "" B_A False, False For i = 4 To Sheets("MyDate").Range("A1000").End(xlUp).Row If ComboBox1 = Sheets("MyDate").Cells(i, 1) Then TextBox2 = Sheets("MyDate").Cells(i, 1).Offset(0, 3) Exit For End If Next If TextBox2 = "مشاهدة وتعديل" Then B_A True, False End Sub Private Sub B_A(ByVal V_a As Boolean, ByVal E As Boolean) If ComboBox1 = "الدعم الفني" Then CommandButton5.Visible = V_a: CommandButton5.Enabled = E: CommandButton6.Visible = V_a CommandButton6.Enabled = E: CommandButton4.Visible = V_a: CommandButton4.Enabled = E Else CommandButton5.Visible = 0: CommandButton5.Enabled = 0 CommandButton4.Visible = 0: CommandButton4.Enabled = 0 CommandButton6.Visible = 0: CommandButton6.Enabled = 0 End If CommandButton3.Visible = V_a TextBox3.Visible = V_a TextBox4.Visible = V_a TextBox3.Enabled = E TextBox4.Enabled = E Label3.Visible = V_a Label4.Visible = V_a CommandButton3.Enabled = E End Sub Private Sub CommandButton1_Click() Dim i As Integer, MyRow As Integer, ii As Integer, Abu_Ahmed As Boolean Dim Sh_A As Worksheet On Error Resume Next Application.ScreenUpdating = False For i = 4 To Sheets("MyDate").Range("A1000").End(xlUp).Row If ComboBox1 = Sheets("MyDate").Cells(i, 1) And Val(TextBox1) = Sheets("MyDate").Cells(i, 2) Then MyRow = Sheets("MyDate").Cells(i, 2).Row Abu_Ahmed = True GoTo 1 Exit For End If Next ' ======== 1: If Abu_Ahmed = True Then Application.Visible = True Sheets("Mydate").DisplayHeadings = False Sheets("My Account").Cells(19, 5) = ComboBox1 & " " & Format(Now(), "yyyy/mm/dd hh:mm") Sheets("MyDate").Cells(Sheets("MyDate").[C50000].End(xlUp).Row + 1, 3) = ComboBox1 & " " & Format(Now(), "yyyy/mm/dd hh:mm") For ii = 5 To Sheets("MyDate").Range("IT3").End(xlToLeft).Column If Sheets("MyDate").Cells(MyRow, ii) = "مشاهدة وتعديل" Then Sheets(Sheets("MyDate").Cells(3, ii).Text).Visible = -1 End If If Sheets("MyDate").Cells(MyRow, ii) = "مشاهدة فقط" Then Sheets(Sheets("MyDate").Cells(3, ii).Text).Visible = -1 Sheets(Sheets("MyDate").Cells(3, ii).Text).Unprotect (Sheets("mydate").Range("b4")) Sheets(Sheets("MyDate").Cells(3, ii).Text).Cells.Locked = True Sheets(Sheets("MyDate").Cells(3, ii).Text).Protect (Sheets("mydate").Range("b4")) End If '------------------------------------------------------------------------------------- If Sheets("MyDate").Cells(MyRow, ii) = "مخفي" Then Sheets(Sheets("MyDate").Cells(3, ii).Text).Visible = xlSheetVeryHidden End If '----------------------------------------------------------------------------------- If Sheets("MyDate").Cells(MyRow, ii) = "مدخل بيانات" Then Sheets(Sheets("MyDate").Cells(3, ii).Text).Visible = -1 Sheets(Sheets("MyDate").Cells(3, ii).Text).Unprotect (Sheets("mydate").Range("b4")) Sheets(Sheets("MyDate").Cells(3, ii).Text).Cells.Locked = True For i = 1 To Sheets(Sheets("MyDate").Cells(3, ii).Text).Cells(1, Columns.Count).End(xlToLeft).Column If Sheets(Sheets("MyDate").Cells(3, ii).Text).Cells(1, i).Value = "T" Then Sheets(Sheets("MyDate").Cells(3, ii).Text).Cells(1, i).EntireColumn.Locked = False End If Next Sheets(Sheets("MyDate").Cells(3, ii).Text).Protect (Sheets("mydate").Range("b4")) End If '------------------------------------------------------------------------------------ Next MsgBox "تفضل بالدخول", vbOKOnly, "تنبيه" Me.Hide With Sheets("My Account") .Activate .[IV1] = "" .[IV1] = Me.ComboBox1 '---------------------------------------------------------------------------- .[IU1] = Sheets("mydate").Range("b4") 'لتخزين كلمه سر الادمن فى هذة الخليه '---------------------------------------------------------------------------- End With Else MsgBox IIf(AA >= 2, "خروج", "دخول خاطئ حاول مرة أخرى "), vbOKOnly + 524288 + 1048576, "تنبيه" ComboBox1 = "": TextBox1 = "" AA = AA + 1 If AA > 2 Then Unload Me Exit Sub End If ActiveWorkbook.Protect (Sheets("mydate").Range("b4")) 'لحمايه المستند بنفس كلمه سر الادمن Application.ScreenUpdating = True End Sub Private Sub CommandButton2_Click() Unload Me End Sub Private Sub CommandButton3_Click() If TextBox3 = "" Or TextBox4 = "" Then MsgBox "الرجاء إكمال الحقول الناقصة", vbOKOnly, "تنبيه": TextBox3.SetFocus: Exit Sub lr = Sheets("MyDate").Range("A1000").End(xlUp).Row Sheets("MyDate").Cells(lr + 1, 1) = TextBox3 Sheets("MyDate").Cells(lr + 1, 2) = Val(TextBox4) With UserForm2 .CommandButton3.Caption = "حفظ جديد" .Label2.Visible = True .Label2.Caption = TextBox3 .ComboBox1.Visible = False .Show End With End Sub Private Sub CommandButton4_Click() If Me.ComboBox1.Value = "الدعم الفني" Then Dim t As Integer With UserForm3 .Label5.Caption = "شاشه تعديل كلمات السر للمستخدمين" .ComboBox1.Value = Me.ComboBox1 t = 4 Do .ComboBox1.AddItem Sheets("MyDate").Cells(t, 1) t = t + 1 Loop Until Sheets("MyDate").Cells(t, 1) = "" .Show End With Else With UserForm3 .ComboBox1.Visible = False .Label7.Visible = True .Label5.Caption = "شاشه تعديل كلمات السر للمستخدم" .Label7.Caption = Me.ComboBox1 .Show End With End If End Sub Private Sub TextBox1_Change() Dim a If Me.TextBox2 = "مشاهدة وتعديل" Then a = 1 Else a = 0 If Len(d) = 0 Then B_A a, False For i = 4 To Sheets("MyDate").Range("A1000").End(xlUp).Row If ComboBox1 = Sheets("MyDate").Cells(i, 1) And Val(TextBox1) = Sheets("MyDate").Cells(i, 2) Then B_A a, True Exit For End If Next End Sub Private Sub B_e(E_a As Boolean) CommandButton3.Enabled = E_a: TextBox3.Enabled = E_a: TextBox4.Enabled = E_a: CommandButton5.Enabled = E_a: CommandButton6.Enabled = E_a End Sub Private Sub B_Con(E_a As Boolean, V_a As Boolean) CommandButton3.Enabled = E_a CommandButton3.Visible = V_a CommandButton4.Enabled = E_a CommandButton4.Visible = V_a CommandButton6.Enabled = E_a CommandButton6.Visible = V_a TextBox3.Enabled = E_a TextBox3.Visible = V_a TextBox4.Enabled = E_a TextBox4.Visible = V_a Label3.Visible = V_a Label4.Visible = V_a End Sub Private Sub UserForm_Activate() B_Con False, False Application.Visible = False ComboBox1.SetFocus Label6.Visible = False End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True MsgBox " !!! سوف يتم اغلاق البرنامج نهائياً " Application.DisplayAlerts = False Application.Quit End Sub

الاخوة مشرفي و اعضاء المنتدئ تحية طيبة واجهتني مشكلة في شريط الصفوف وهي اختفاء عدد كبير من الصفوف في ورقة العمل و ضهرت الصفوف الضاهرة باللون الازرق كما في الصورة المرفقة

جزاك الله كل خير اخي سليم ... و اشكرك على رحابة صدرك

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

هاهو الملف المطلوب ارفقه الى سيادتكم اوجو ان لا اكون اتعبتك هاني محمد.xlsx

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

هل هذا الخطاء في اعدادات الاكسل ام خطاء في الصيغة المكتوبة ام في لوحة المفاتيح ؟

السلام عليكم لدي برنامج صلاحيات دخول مستخدمين نقلته عبر الايميل الى كمبيوتر اخر ولكنه لم يشتغل هل بالمكان معالجة الامر ؟ برنامج صلاحيات.xlsm