klma7lwa

الاخ الفاضل محمد 

شكرا للمساعدة والملف يعمل كما هو مطلوب ، جعله الله فى ميزان حسناتك

شكرا اخى محمد على اهتمامك

لكن عند تجربة المرفق يقوم الفورم بالاضافة والتعديل على الجدول الاساسى ولا يقوم بالاضافة بجدول الLog

كما تظهر هذه الرسالة عند محاولة الدخول على الQuery

السلام عليكم ورحمة الله وبركاته 

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

بحيث عند اضافة سطر جديد من خلال الفورم ‘User المرتبط ب جدول Users يقوم بتسجيل نفس السطر بجدول UserLog 

وعند التعديل على سطر بيانات موجود بالفعل من خلال الفورم ‘User المرتبط ب جدول Users يقوم بالتعديل على السطر بجدول User  واضافة سطر جديد فى جدول UserLog بالتعديلات

شاكر مجهودكم مقدما

UserLog.accdb

لو اكبر قيمة فى الخلايا d16 and i16 and n16 and s16 and x16 and ac16 and ah16 and am16 تساوى 0 اذا اجعل قيمة الخلية فارغة و لو اقل قيمة فى نفس الخلايا اقل من 50 اذا راسب لو تساوى او اكبر من 50 ناجح 

IF هى تعنى لو 

max  البحث ان اكبر قيمة  وهى الشرط الاول

" d16 and i16 and n16 and s16 and x16 and ac16 and ah16 and am16 " الخلايا المراد البحث داخلها عن اكبر قيمة

=0    لو اكبر قيمة تساوى 0

""  معناها فارغة اى انه يجعل قيمة الخلية فارغة فى حالة تحقق الشرط الاول 

ماذا لو لم يتحقق الشرط 

قام بعمل شرط جديد 

IF هى تعنى لو 

min البحث ان اقل قيمة   الشرط الثانى

" d16 and i16 and n16 and s16 and x16 and ac16 and ah16 and am16 " الخلايا المراد البحث داخلها عن اقل قيمة

<50 اقل من 50

"راسب" اذا كانت النتيجة اقل من 50 سوف يعطى ناتج " راسب "

" ناجح " اذا لم يتحقق الشرط الاول وهو ان اكبر قيمة تساوى صفر والشرط الثانى اقل قيمة اصغر من  50 تكون النتيجة ناجح 

اتمنى ان يكون شرحى وافى بالغرض 

UP       last time

جرب هذا وياريت يكون طلبك اوضح مثلا ماذا اذا كان الفرق اقل من 1% زياده او نقصاناً 

=IF(O4-E4<=0.01;O4;IF(O4-E4>=0.01;"بيع";""))

UP

Up

ان شاء الله تفى بالغرض 

=IF((B1-A1)<0.03;B1;"")

ضع المعادلة التالية فى الخلية L5 واسحبها لاسفل

=IF(D5="أبو شاكر";K5*0.33;IF(D5="أبو مروان";K5*0.33;IF(D5="أبو سعيد";K5*0.2;"")))

وان شاء الله هذا يفى بطلبك بالملف مع العلم فى حالة اختلاف الاسم سوف تعطيك النتيجة 0

السلام عليكم ورحمة الله وبركاته 

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

السلام عليكم ورحمة الله وبركاته 

اخوانى الكرام اريد معرفة كيفية تفقيط المبالغ بالجنيهات فى الاكسس وبدون اكواد او ميكرو حيث تم تعطيل وحدات الميكرو لدى بالعمل ولا يمكن تفعلها

السلام عليكم ورحمة الله وبركاته 

اخى الكريم يرجى ارفاق الملف وسوف اقوم بازالة الحماية عنه وارفقه لك 

ولن اقول الطريقة لعد استخدامها فى اشياء غير شرعية 

السلام عليكم ورحمة الله وبركاته 

اخى الكريم اذا كنت تستخدم Microsoft Office 2007 or 2010 or 2013 يمكنك عند الطباعة اختيار الطابعة 

وحفط الملف بصيغة XPS ولكن لا يمكنك التعديل على هذا النوع من الملفات 

ويمكنك تحميلها وطبعها من جهازك بالمنزل 

السلام عليكم ورحمة الله وبركاته 

الاخوة الكرام 

الاستاذ/ ضاحي الغريب

الاستاذ/ شوقى ربيع 

عمل اكثر من رائع ومجهود جبار ندعو الله ان يجعله فى ميزان حسناتكم 

وبعد اذن اخوانى الكرام هل يمكننى الاطلاع على الاكواد المستخدمة فى البرنامج عاليه حيث انى تمكنت من كسر الرقم السرى الخاص بالVBA ولكنى اطب الاذن منكم بالاطلاع على الاكواد لعلى اجد ما اتعلمه من عملكم الاكثر من رائع علما بأنى لم انشرها فى يوم من الايام وان حدث ادعو الله ان يجعلها فى ميزان حسناتكم تحت مسمى " علم ينتفع به " 

علما بانى لن استفيد بالبرنامج لانه لا يناسب طبيعة عملى ولكن يمكن الاستفاده من الافكار المستخدمة والاكواد

وانا فى انتظار الموافقة على الاطلاع على الاكواد ان شاء الله

الحمدلله وجت ضلتى ولحل المشكلة التى ذكرتها بالاعلى يرجى اتباع التالى 

فى خصائص اليوزر فورم عدل قيمة ShowModal من True الى False

وفى احداث ملف الاكسل ThisWorkbook

Private Sub Workbook_Open()
Windows("ExcelFileName.xlsm").Visible = False 'ExcelfileName اسم ملف الاكسل الذى يحتوى على اليوزر فورم 

UserForm1.Show
End Sub

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

Private Sub Workbook_Open()
Dim MyFlName As String
  MyFlName = "ExcelFileName.xlsm"

    If ThisWorkbook.Name <> MyFlName Then
    MsgBox "ExcelFileName تم اغلاق الملف يرجى عادة تسمية الملف الى ", vbOKOnly + vbMsgBoxRight + vbCritical, "خطاء فى اسم الملف"
    If vbOK Then
    Application.DisplayAlerts = False
    ThisWorkbook.Close
  End If: End If
Application.ShowStartupDialog = False
Application.DisplayAlerts = False
Windows("ExcelFileName.xlsm").Visible = False 
UserForm1.Show
End Sub

مع العلم ان كود عدم التعديل على اسم الملف على ما اتذكر للاستاذ "ابو تامر" حفظه الله وكان عن طريق رد لاستاذ "عبدالله المجرب"حفظه الله فى هذا الموضوع  هنا

تفضل اخى الكريم هذا كود لطلبك الثانى 

Private Sub CommandButton1SV_Click()
ActiveCell.EntireRow.Delete
Sheet2.Activate
With Sheets("Stocks")
On Error Resume Next
Dim Lr As Integer
Lr = [B10000].End(xlUp).Row + 1
.Cells(Lr, 2) = TextBox18SV.Value
.Cells(Lr, 4) = TextBox20SV.Value
.Cells(Lr, 3) = TextBox24SV.Value

'Call calerForm
        TextBox17SV = ""
        TextBox19SV = ""
        TextBox18SV = ""
        TextBox20SV = ""
        TextBox22SV = ""
        TextBox24SV = ""
        TextBox23SV = ""
        TextBox25SV = ""
        TextBox21SV = ""
End With

End Sub

تفضل اخى هذا الكود لاستدعاء البيانات الى اليوزر فورم

Private Sub TextBox17SV_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Sheets("Vents")
.Activate
If TextBox17SV = "" Then CommandButton1SV.Enabled = False Else SupprimerV.Enabled = True
If TextBox17SV <> "" Then CommandButton1SV.Enabled = True Else SupprimerV.Enabled = False

    On Error Resume Next
    
    Columns(1).Find(TextBox17SV, MatchCase:=True).Activate
        TextBox19SV = ActiveCell.Offset(0, 1).Value
        TextBox18SV = ActiveCell.Offset(0, 2).Value
        TextBox20SV = ActiveCell.Offset(0, 3).Value
        TextBox22SV = ActiveCell.Offset(0, 4).Value
        TextBox24SV = ActiveCell.Offset(0, 5).Value
        TextBox23SV = ActiveCell.Offset(0, 6).Value
        TextBox25SV = ActiveCell.Offset(0, 7).Value
        TextBox21SV = ActiveCell.Offset(0, 8).Value
        TextBox19SV.Value = Format(TextBox19SV.Value, "dd/mm/yyyy")
    On Error GoTo 0
End With
End Sub

وهذا الكود لنقل الصف الذى يظهر بياناته فى اليوزر فورم الى Stocks ويخذف من Vents  ولكنلم اجد دلالة للنقل اين الكمية يتم نقلها واين السعر واين ينقل باقى البيانات انا لم اجد سوى الاسم فقط لذلك انا قمت بعمل نقل لصف البيانات ويمكنك التعديل عليه

Private Sub CommandButton1SV_Click()
With Sheets("Vents")
Dim cl As Range
For Each cl In Range("A8:A" & [A10000].End(xlUp).Row)
cl.Offset(0, 2).Resize(1, 9).Copy Sheets("Stocks").Range("B" & Sheets("Stocks").[B10000].End(xlUp).Row + 1)
cl.Offset(0, 0).Resize(1, 9).Delete Shift:=xlUp
Next
End With
End Sub

تفضل اخى الكريم الروابط بالنسبة للملف الاول 

='C:\Docs\2011\Dec-201313\files\[330904 DEC-13.xlsx]sheet1'!$C$37
='C:\Docs\2011\Dec-201313\files\[330904 DEC-13.xlsx]sheet1'!$E$42
='C:\Docs\2011\Dec-201313\files\[330904 DEC-13.xlsx]sheet1'!$E$73

ويمكنك تكرار الارتباط بعاليه مع تغير اسم ملف الارتباط

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

فى الملف المراد ان يظهر به القيمة(الملف الذى ارفقته انت) وفى الخلية المراد ان يظهر بها الارتباط اضغط = ثم ادخل للملف الاصلى للقيمة وقم بالوقوف على الخلية المراد اظهار قيمتها ثم اضغط انتر

يمكنك اخى الكريم زيارة هذا الموضوع 

 وان شاء الله تجد ما تريد به  

اخى الفاضل المشكلة فى نظام التشغيل وليس الاكسل ويمكنك تعديل طريقى عرض التاريخ ولغة الارقام سواء هندى او عربى من خلال الاتى :

<For" Windows 8.1 or Seven "> Control Panel > Language > Location >Formats >l  

up

اخى الفاضل 

تم وضع الكود فى احداثيات الشيت ويمكنك الضغط على Alt+F11 للدخول الى محرر الاكواد وبالضغط على احداثيات الشيت والذى هو لديك sheet6(CARD)  سوف تجد الكود 

اما بالنسبة لتصميم Comb فهو اختصار لCommandButton ويمكنك تسميته كيف تشاء فانا قمت باختصاره ب Comb ويمكن ادارجه من تبويب المطور )Developer( ثم ادراج ولا تسنى الضغط على وضع التصميم (Design Mode) اذا اردت التعديل على ال CommandButton 

بعد اذن اخى الفاضل حمادة عمر

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

tist.rar

اخى الكريم عبدالله باقشير 

دائما ما تبهرنى بأداك العالى والراقى 

دائما سباق بالخير والعطاء فقد تعلمت على يدك الكثر وعلى يد اساتذتى الكرام داخل هذا الصرح العظيم 

فعلا هذا هو المطلوب 

جعله الله فى ميزان حسناتك يوم ان تلقاه