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

بسم الله الرحمن الرحيم السلام عليكم ورحمه الله وبركاته طبعا انا مسجل من فترة طويلة والصراحة منتدى مبدع واستفدت كثير وطرق كثيرة و استاذة كبار المنتدى حبيت اشارك بهذا الموضوع البسيط والكثير يبحث عنة وإن شاء الله اكون عند حسن الظن اخفاء الجداول و اظهارها على زر اظهار و اخفاء بكل بساطة ووضعت لكم الاكواد مع شرحها زر اخفاء الجداول اسم الزر ( HideTables ) كود الزر Dim db As DAO.Database Dim tbl As DAO.TableDef Set db = CurrentDb ' قم بتحديد الجداول التي ترغب في إخفائها ' يمكنك تكرار هذا السطر لإضافة المزيد من الجداول Set tbl = db.TableDefs("اسم_الجدول") ' قم بتعيين خاصية Hidden للجدول إلى True لإخفائه tbl.Attributes = dbHiddenObject ' أغلق قاعدة البيانات db.Close Set tbl = Nothing Set db = Nothing كود زر اظهار الجداول اسم الزر ( ShowTables ) Dim db As DAO.Database Dim tbl As DAO.TableDef Set db = CurrentDb ' قم بتحديد الجداول التي ترغب في إظهارها ' يمكنك تكرار هذا السطر لإضافة المزيد من الجداول Set tbl = db.TableDefs("اسم_الجدول") ' قم بتعيين خاصية Hidden للجدول إلى False لإظهاره tbl.Attributes = tbl.Attributes And Not dbHiddenObject ' أغلق قاعدة البيانات db.Close Set tbl = Nothing Set db = Nothing ودمتم سالمين باحطاب سوفت

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاتة اهلا بكم اعضاء المنتدى الكرام اعتذر جدا للغياب الطويل عن المنتدى ولكن اشتقت اليكم فقولت ارجع بكود ممكن يفيد البعض فى عملة يعتبر البحث عن البيانات من الامور التى يبحث عنها كل مستخدمى الاكسل حيث انها تسهل عليهم اعمالهم وتحليل البيانات لديهم ولكن اذا كان لديك بيانات كثيرة جدا فى شيت الاكسل فالامر هنا يكون شاق ومرهق ومن هنا قررنا انشاء كود بحث من خلال اليوزرفورم يقوم بالبحث عن البيانات وتلوين واظهار نتائج البحث يتم وضع الكود فى حدث التكست بوكس Dim Itemsaerch As String Dim rng As Range Dim cell As Range Dim lr As Long Sheet1.Cells.Interior.Pattern = xlNone Itemsaerch = Me.TextBox1.Value lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Set rng = Sheet1.Range("a2:a" & lr) For Each cell In rng If InStr(1, cell.Value, Itemsaerch) > 0 Then cell.Interior.Color = vbGreen End If Next cell If Me.TextBox1.Value = "" Then Sheet1.Cells.Interior.Pattern = xlNone ملف العمل فورم بحث جديد وتلوين نتائج البحث.xlsm

عند فتح النموذج لا يظهر نهائيا في الشاشة وعندما عدلت في كود التحميل الى هذا leftPos = A * 6.88 topPos = B * 7.88 ظهر كما في الصورة

نعم بدون اي تدخل او تحريك

الدقة 3840 * 2160

احببت ان افرد موضوعي هذا بعنوان مستقل 1-لان غالب او جميع الدروس هنا تتعامل مع واتساب ويندوز 2-وحتى يكون تطوير هذا العمل مستقلا ولا يحدث خلط بين الامثلة المثال المرفق تم تطبيقه على واتساب ويب واليكم بعض التوجيهات والملاحظات : كانت مشكلتي في محاولات سابقة انه في كل مرة يتم الارسال وفتح الواتساب ويب .. فانه يطلب ربطا جديدا بالجوال وبحمد الله توصلت الى حل هذه المشكلة التي كانت عائقا حقيقيا .. يكتفى بالارتباط مرة واحدة فقط الآن : عند كل ارسال يفتح الواتس ويب بشاشة جديدة .. فان كانت هناك نسخة مفتوحة من قبل فانه يتجاهلها وتصبح غير فعالة وهذه لا مشكلة فيها لأنه يفتح على الحساب نفسه . ارجوا من اخوتي واحبتي الذين يمرون من هنا تجربة المثال وافادتي بنتيجة التجربة ، من اجل الانتقال الى الخطوة التالية وهي ارسال المرفقات ملحوظة : المرفق sendwatsWebAll .. هو النسخة المحدثة والمطورة بعد أخذ آراء وتجارب الإخوة sendwatsWeb.mdb sendwatsWebAll.rar

مشكور، طريقة أخرى لإظهار الجدول وإخفائهHideTable.accdb

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي جرب هدا (تم اظافة ورقة جديدة مخفية على الملف باسم PDF لتجميع الفواتير اظن ان مدى بيانات الفاتورة غير مطابق لما كتبته هنا ادا لم اكن مخطئ Sub svPDF() Dim MyRng As Range, r As Long, i As Integer, LR As Long Dim fRow, Cpt As Range, FndRng As Range, myValue As String Dim sFile As String, FolderName As String Set desWS = Sheet79: Set WS = PDF Set MyRng = desWS.[BW330:CK372] minDate = Format(desWS.[DC330], "yyyy-mm-dd"): maxDate = Format(desWS.[CV330], "yyyy-mm-dd") 'قم بتحديد مسار حفظ الملف بما يناسبك 'Path = "C:" ' المسار الافتراضي للملف الرئيسي Path = Application.ActiveWorkbook.Path 'اسم الملف المستخرج sFile = minDate & " " & "الفواتير من" & " " & maxDate & " " & "الى" ' اسم مجلد الحفظ FolderName = "raed": 'شرط فواصل الصفحات myValue = "اجمالى الواصل" If Len(desWS.[CA328].Value) = 0 Then Exit Sub Application.ScreenUpdating = False On Error Resume Next WS.Visible = xlSheetVisible: WS.Cells.Clear For i = desWS.[CA328] To desWS.[CE328]: desWS.[BU331].Value = i With ActiveWorkbook sPath = Path & Application.PathSeparator & FolderName & Application.PathSeparator If Len(Dir(sPath, vbDirectory)) = 0 Then End If MkDir sPath MyRng.Copy LR = WS.Cells(Rows.Count, "j").End(xlUp).Row + 4 With WS.Range("A" & LR) .PasteSpecial xlPasteValues: .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End With Next i With WS fRow = .Range("a:o").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Set FndRng = .Range("j10:j" & fRow) Set Cpt = FndRng.Find(What:=myValue, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext) If Not Cpt Is Nothing Then: Linge = Cpt.Address Do If Not Cpt Is Nothing Then: Cpt.Offset(2).PageBreak = xlPageBreakManual Set Cpt = FndRng.FindNext(Cpt) If Cpt Is Nothing Then: Exit Do If Cpt.Address = Linge Then: Exit Do Loop WS.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1 End With WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & Application.PathSeparator & sFile & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False WS.Visible = xlSheetVeryHidden On Error GoTo 0 Application.ScreenUpdating = True End Sub Book2.xls

السلام عليكم و رحمة الله استخدم هذا الكود Sub Summing() Dim C As Range, i As Long Dim a As Integer, b As Integer i = 3 Do While i <= 4 a = Range("E" & i): b = Range("F" & i) For Each C In Range("A3:A9") If C.Value >= a And C.Value <= b Then k = k + C.Offset(0, 1) Range("G" & i) = k End If Next k = 0 i = i + 1 Loop End Sub

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) كثيراً منا حاول تشغيل تطبيقات ومشاريع آكسيس على الجوال ؛ ولكن دون نتيجة حقيقية أو فعالة . اليوم وبعد تجربة شخصية لتشغيل برامج آكسيس على الجوال بكل بساطة . دون مقدمات طويلة وعريضة لمبدأ بالمطلوب والأساسيات لتنفيذ هذه الفكرة . البرامج المطلوبة :- برنامج Limbo-x86 ؛ وهو البرنامج الوسيط لإنشاء جهاز كمبيوتر على الجوال . ويتم تثبيته على الجوال . ( APK ) نسخة Windows7 تم تثبيتها على الهاتف من نوع Huawei Y9s بمواصفات عادية ( ! ) . وتم تفعيل اللغة العربية بشكل كامل . ولم يتم حذف أي من مكوناتها . أيضاُ تم تثبيت نسخة أوفيس 2010 كاملة . ( QCOW2 ) برنامج ISO Craft-1.6 ، وسيتم ذكر وظيفته لاحقاً . أيضاً يتم تثبيته على الجوال ( APK ) طريقة العمل :- بعد نسخ الملفات التي تم تحميلها . يتم تثبيت التطبيق الأول Limbo-x86 وفتحه . لا بد من ضبطه بشكل بسيط كالآتي :- من النقاط الثلاثة أقصى اليمين نختار Settings . ثم نفعل الصلاحية للوصول لمدير الملفات ، وكذلك الأمر بالنسبة للـ Orientation نجعلها تساوي Landscape . كما في الصورة . ثم ننزل لأسفل عند الجزء Advanced ومنها الخيار High Priority نقوم بتفعيلها . ثم رجوع لواجهة البرنامج . الآن سنقوم بإنشاء جهاز كمبيوتر وهمي من خلال المثلث الصغير None ثم New ، ثم اكتب أي اسم تريده ( مثلاً Win7 ) . الآن سنقوم بضبط بعض الأمور ليعمل الجهاز الوهمي بأقل المواصفات ( حسب مواصفات الجوال ) . بالصور في الصورة التالية ، تستطيع تجربة أي الخيارات أفضل لك حسب نوع ومواصفات جهازك للتوضيح في هذا الجزء المهم . Machine Type & CPU Model & Enable MTTCG يجب تحديدهم كما هم بالصورة ( بعد عدة تجارب طبعاً ) الآن سنقوم بتحديد مسار نسخة الويندوز التي تم تحميلها ونسخها إلى ذاكرة الهاتف في Hard Disk A الآن بعد إتمام الإعدادات المطلوبة ، وقمنا بتشغيل الكمبيوتر الوهمي الذي تم إنشاءه . هذا الفيديو توضيحي للنسخة المرفقة في الروابط . طبعاً إجابةً لعدة استفسارات سيتم السؤال عنها وهي ( بطئ النسخة ، حجم الشاشة هل ستساعد ، الفكرة غير ناجحة لأسباب أخرى ما السبب ؟ .... ) كلها تعتمد على أن كرت الشاشة في التجربة هو السبب لأنه كرت شاشة وهمي ويعتمد على الذاكرة العشوائية للجوال . فعند تجربتي على جوالي الـ Huawei Y9s استغرق التشغيل والإقلاع الكامل تقريباً 6 دقائق ، بينما على جوال Samsung Note +10 استغرق التشغيل والإقلاع تقريباً 3 دقائق . ( ليست دعاية أو تسويق لأي منتج أو شركة ؛ وإنما توضيح للتجربة أين تم تطبيقها ) الآن نأتي لبرنامج ISO Craft-1.6 وما هي وظيفته وحاجته ؛ هذا البرنامج يستخدم لإنشاء ملفات الـ ISO على الجوال لإستخدامها كمحرك أقراص CD داخل البرنامج ونسخة الويندوز التي تم انشائها . وكتوضيح ؛ بما أن الويندوز الذي تم تشغيله مستقل بذاته عن الهاردوير ( القطع ) في الجوال فسنحتاج الى محرك أقراص وهمي ، وسيتم اختياره من هذا الخيار في البرنامج الرئيسي Limbo . أشكر لكم سعة صدركم إن كان الموضوع طويلاً . وإن فاتني نقطة لم ألتفت لها أرجو التنبيه بالتعليقات والمشاركات وسيتم العمل على التوسع في الفكرة بحيث تشمل الفكرة التطبيق على نسخة Windows 10 و أيضاً نسخة Windows XP