نجوم المشاركات

قم باضافة التالى Me.Frame1.Height = Me.Frame1.Height + 14 If Me.Frame1.Height > 365 Then Me.Frame1.Height = 365 Me.ListBox2.Height = 280 End If

وعليكم السلام يكفي COUNT بدون شرط إلا إذا كنت تريد عد أرقام محددة فقط =COUNT(B2:B10)

وعليكم السلام ورحمة الله وبركاته ضع هذا قبل اخر End If Me.Frame1.Height = Me.Frame1.Height + 14 Me.ListBox2.Height = ListBox2.Height + 14 Me.Label8.Top = Me.Frame1.Top + Me.Frame1.Height + 10: Me.Label9.Top = Me.Label8.Top + Me.Label8.Height: Me.Label10.Top = Me.Label9.Top + Me.Label9.Height Me.TextBox1.Top = Me.Label8.Top: Me.TextBox2.Top = Me.TextBox1.Top + Me.TextBox1.Height: Me.TextBox3.Top = Me.TextBox2.Top + Me.TextBox2.Height Me.CommandButton1.Top = Me.Label8.Top

عليكم السلام جرب استخدام هذا الكود بعد تحديد الخلايا التي يراد وضع ارتباط تشعبي لها Sub AddHypaerlinks() Dim cl As Range Dim myPath As String, fileName As String myPath = "C:\Users\civat\Desktop\New folder\" 'SET TO WHERE THE FILES ARE LOCATED For Each cl In Selection If Len(cl) > 0 Then fileName = myPath & cl.Value & "*.docx" 'IF THE FILE EXISTS THEN If Len(Dir(fileName)) <> 0 Then ActiveSheet.Hyperlinks.Add cl, myPath & Dir(fileName) End If Next End Sub بالتوفيق

تفضل اخى الفاضل ياسر جرب الملف Example (1).xlsm

وعليكم السلام ورحمة الله وبركاته استخدم هذه المعادلة لعلها المطلوبة =COUNTIF(B1:B10;">0")

حسب فهمي للمطلوب طبعا بعد جعل جميع خلايا الشيت مؤمنة ومخفية locked & hidden ما عدا الخلايا المسموح بالكتابة فيها (بحذف علامة الصح بجوار locked & hidden ) من التبويب الأخير لنافذة تنسيق الخلايا (protection حماية ) ثم اثناء حماية الشيت من تبويب مراجعة review قم بإلغاء تحديد الخلايا المؤمنة (الملونة باللون الأصفر في الصورة التالية) بالتوفيق

إن شاء الله يفيدك هذا الملف نموذج بسيط لاختيار الوقت مثل اختيار التاريخ بالتوفيق time picker.xlsb

السلام عليكم جرب الكود التالي Sub Test() Dim sRow As Long, eRow As Long sRow = 8: eRow = 19 With ActiveSheet .Range("D" & sRow & ":D" & eRow).Value = .Range("F" & sRow & ":F" & eRow).Value .Range("E" & sRow & ":E" & eRow).Value = 0 End With End Sub

السلام عليكم خير الكلام ما قل ودل . اللهم صل على محمد وآله وصحبه . بسبب ملاحظتي لحرص البعض _خاصة المستجدين _ على مسألة الحماية واستخدام طرق معقدة والبحث عن الجديد والأقوى احببت ان انشر تجربتي وخبرتي في هذه المسألة كأيسر وكذلك اقوى طريقة . الحماية من جهتين : 1- حماية البيانات وهي الجداول .. وهذه تهم المستخدم ( العميل) 2- حماية البناء ..( التصميم بما يشتمل من اكواد وغيرها ) وهذه تهم المبرمج ----------------------------------- الجهة الأولى : 1- اكسس ضعيف جدا في حماية جداوله .. لأن اي مستخدم مهما ضعفت صلاحياته يمكنه التمكن من الجداول ( نسخ / تغيير / حذف) 2- اي شخص يملك قاعدة بيانات اكسس يمكنه الوصول الى الجداول ما لم يتم حمايتها بكلمة مرور اكسس 3- ينطبق هذا على القواعد المقسمة حيث يجب تفعيل كلمة مرور اكسس على الواجهات الأمامية قبل عرض كلمة مرور المستخدم ، والا ستكون الجداول في متناول اليد . نأتي للجهة الثانية وهي ما يخص المبرمج : من خلال تجارب وخبرة سنوات افضل طريقة تريح المبرمج وكذلك العميل وبعيدا عن غرس الملفات والريجستري والفلاش : الاعتماد على رقم سيريال واحد من عتاد الجهاز ( قرص صلب / معالج / اللوحة الأم ) بشرط ان يكون الرقم اساسي خاصة القرص الصلب لا يتغير عند عمل التهيئة . فكون الرقم اساسي لا يتغير يفيد العميل عندما يقوم بتهيئة القرص ، وهو مريح ايضا للمبرمج ( يوجد كثير من المواضيع هنا في هذا المنتدى تشرح عملية استخلاص ارقام القطع الداخلية لجهاز الحاسب .. ابحث ) الخطوات : --------------------------------- - استخراج واستخلاص الارقام من السيريل ( غالبا يأتي مختلط بارقام وحروف) سيظهر هذا الرقم للعميل في فورم التسجيل واسفله حقل لادخال رقم النسخة ------------------------------- - نعمل دالة1 = استقطاع جزء محدد من النتيجة .. مثلا خمسة ارقام او اربعة ارقام من اليمين او من اليسار ( استقطاع ثابت) - نعمل دالة2 = اجراء معادلة على دالة1 ، مثلا ( دالة1 (x) 1234567 + 53954 ) ------------------------------- - عندما يرسل العميل رقم السيريل ويطلب رقم النسخة نقوم بعمل المعادلة ومن ثم نرسلها للعميل نتيجة هذه المعادلة ستبقى ملك دائم لجهاز حاسب واحد ما دام على قيد الحياة -------------------------------------------------------------------------------------------------------------- ما ذكرته اعلاه هو للنسخة الدائمة .. أما النسخة المؤقته فأقوم بعملها كالتالي : يجب ان يكون العمل مقسم الى واجهات وجداول . يجب ان اتعامل مع العميل على اساس نسختين من الواجهات : مؤقتة / دائمة الفرق بين الواجهة المؤقتة والواجهة الدائمة .. هي زيادة سطرين بشرطين في المؤقتة 1- الشرط 1: لن تفتح المؤقتة الا مع وجود الأنترنت شغال 2- نضع سطرا نحدد تاريخ توقف البرنامج ( يتم جلب التاريخ من الانترنت ) لنفرض انتهت مدة التجربة بعد شهر او شهرين .. وتم الشراء .. هنا نرسل الواجهة الدائمة للصق والاستبدال . هنا نكون حافظنا على بيانات العميل المدخلة وعلى حقوقنا البرمجية ----------------------------------------------------- نقطة اخيرة : سيتبادر الى الذهن ! اين يحفظ رقم النسخة ؟ لأن البرنامج سيطلبه عند كل اقلاع ؟ الجواب : ما دام رقم النسخة ملكا للجهاز فيمكن حفظه في اي مكان ، مثلا في حقل في جدول بشرط ان يحتوي الجدول على سجل واحد فقط او يمكن حفظه في ملف نصي بجانب قاعدة البيانات وهذه الطريقة الاخيرة هي الافضل بل تجب اذا تم توزيع الواجهات على اكثر من جهاز .. والسبب ان كل جهاز سيكون له رقمه الخاص هذا ما لدي آمل تجدوا فائدة

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

هذا ملفك بعد تنفيذ التعليمات الواردة في المشاركة السابقة وطبعا طريقة تحديد الانتقال بعد انتر في الخيارات معروفة ملف -- خيارات -- متقدم ثم تختار يمين كما بالصورة Example.xlsm

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

وعليكم السلام ورحمة الله وبركاته الملف المرفق محرر الاكواد مغلق بكلمة سر جرب الكود التالى Private Sub Worksheet_Change(ByVal Target As Range) Dim NextCell As Range Dim ActiveCell As Range If Not Intersect(Target, Me.Range("C14:L35")) Is Nothing Then Set ActiveCell = Target Select Case ActiveCell.Column Case 3 Set NextCell = ActiveCell.Offset(0, 3) Case 6 Set NextCell = ActiveCell.Offset(0, 6) Case 12 If ActiveCell.Row < 35 Then Set NextCell = Me.Cells(ActiveCell.Row + 1, 3) End If End Select If Not NextCell Is Nothing Then NextCell.Activate End If End If End Sub فى حدث الورقة Change

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

ادرج ptrsafe ليصبح Declare PtrSafe Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal filename As String, ByVal snd_async As Long) As Long

لا شيء .. فاللغة العربية بحر .. " سددوا وقاربوا " .. والمقاربة هنا جميلة .. ما يخرج عن السياق لا يصل عدد اصابع اليد الواحدة

جميل .. واذا الاسم عبدون هل سيفصله؟ .. عندنا عائلة اسمها العبدان

وعليكم السلام ورحمة الله وبركاته جسب فهمى لطلبك / قم باختيار الصف م خلية Z2 في صفحة البيانات ثم قم بالضغظ على زر ترحيل . سيتم الترحيل الى صفحتي المستجدين وسجل 31, امر الطباعة ديناميكي بمعني حسب البيانات يحتويها ويطبعها فليس هناك داع لزر الاختيار الامر الثالت غير واضح تماما بالنسبة لي والذي فهمته انك تريد الترحيل حسب التقدم فمثلا تريد ترحيل الدور الاول هل الترحيل لفصل معين ام لكل الفصول. اتمنى ان تجد ما يفيدك وان كان غير ذلك فعذرا . ترحيل.zip

لا , لا يمكن لانه لا يعرف ماذا حفظت في ريجيستري بالتفصيل , واذا عرف ذلك نعم يمكن ... بهذه الطريقة حسب المثال الاعلى DeleteSetting "aa", "bb", "trial"

عليكم السلام يمكنك وضع هذه المعادلة في الخلية F3 =(SUM(B3,E3)-SUM(A3,D3))*24 بالتوفيق

اذا كنت تقصد اظهار التقويم لاختيار التاريخ عندها يمكن استخدام اداتين date picker او calendar . هذه محاولة بعد القيام بإضافة فورم التقويم والقيام ببعض التعديلات . قم بالنقر مرتين علي خلية التاريخ وسيظهر التقويم . ولكن هذا يتوقف على اصدار الاوفيس اشك انها تعمل مع الإصدارات قبل 2016 واذا واجهتك مشكلة بإظهار رسالة بعدم وجود كائن عنده يجب تنصيبه حتى يظهر لك . حاليا يعمل معي باستخدام بإصدار 2019 تحياتي مطلوب تعديل.xlsm

تفضل هذا الملف .على الرغم ان كان عليك من البداية رفع ملف بالمشاركة فلا تعنى أى مشاركة شيء بدون ملف يدعمها Colored.xlsb

On Error Resume Next If TextBox8.Value = "" Then ListBox1.Clear: Exit Sub Dim X As Worksheet Dim c As Range Dim k As Integer Dim m As Date Dim n As Date ListBox1.Clear k = 0 m = CDate(TextBox9.Value) n = CDate(TextBox10.Value) For Each X In ThisWorkbook.Worksheets ss = X.Cells(Rows.Count, 2).End(xlUp).Row For Each c In X.Range("B2:B" & ss) If (c.Value Like "*" & ComboBox1.Value & "*" Or c.Value Like "*" & ComboBox2.Value & "*") And (c.Offset(0, 2).Value >= m And c.Offset(0, 2).Value <= n) Then ListBox1.AddItem ListBox1.List(k, 0) = X.Cells(c.Row, 1).Value ListBox1.List(k, 1) = CDate(X.Cells(c.Row, 2).Value) ListBox1.List(k, 2) = X.Cells(c.Row, 3).Value ListBox1.List(k, 3) = X.Cells(c.Row, 4).Value ListBox1.List(k, 4) = X.Cells(c.Row, 5).Value ListBox1.List(k, 5) = X.Cells(c.Row, 6).Value ListBox1.List(k, 6) = X.Cells(c.Row, 7).Value ListBox1.List(k, 7) = X.Cells(c.Row, 8).Value ListBox1.List(k, 8) = X.Cells(c.Row, 9).Value ListBox1.List(k, 9) = X.Cells(c.Row, 10).Value k = k + 1 End If Next c Next X

السلام عليكم و رحمة الله استخدم الكود التالى Sub CallData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, y As Long Dim C As Range, Temp() Dim Counter As Long Set ws = Sheets("Sheet4") t = Timer Application.ScreenUpdating = False '----------------- On Error Resume Next ws.Range("A2:C1000").ClearContents For Each Sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3")) LR = Sh.Range("A" & Rows.Count).End(3).Row Counter = Counter + LR Next '----------------- ReDim Preserve Temp(Counter, 4) y = 0 For Each Sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3")) For Each C In Sh.Range("A2:A" & LR) If Len(C.Value) > 0 Then Temp(y, 0) = C.Value Temp(y, 1) = C.Offset(0, 1) Temp(y, 2) = C.Offset(0, 2) y = y + 1 End If Next Next '----------------- If y > 0 Then ws.Range("A2").Resize(y, 4).Value = Temp '----------------- Application.ScreenUpdating = True MsgBox Round(Timer - t, 2) End Sub

يمكنك وضع هذه المعادلة في الخلية B4 =DATE(MID(LEFT(RIGHT(I4,12),8),1,4),MID(LEFT(RIGHT(I4,12),8),5,2),MID(LEFT(RIGHT(I4,12),8),7,2)) والاستغناء عن الأعمدة المساعدة بالتوفيق