Foksh

والخبر الجيد بحكم تجربتي مع استيراد بيانات من جوجل شيت الى جداول اكسيس نعم ، يمكنك تحويل الملف إلى Google Sheets واستبدال أكواد VBA بـ Google Apps Script (لغة برمجة مختلفة) طبعاً للوهلة الأولى هذا غير ممكن بشكل مباشر ، لكن يمكنك استخدام Google Apps Script كما أخبرتك لإنشاء وظائف مماثلة في Google Sheets وطبعاً مستقبلاً سأحاول ادراج موضوع بهذا الخصوص ( لضيق الوقت 😇 )

وعليكم السلام ورحمة الله وبركاته .. بالنسبة للسطرين التاليين :- سيتم الذهاب الى المجلد Backup ، طبعاً بغض النظر عن وجود المجلد أو لا ( أي أنه لا يتم التحقق من وجود المجلد قبل فتحه ) .. ثم لاحظت انك انتقلت الى المجلد :- فما الهدف !!!!! إلا إذا كان مقصدك ان المجلد السابق موجود داخل المجلد Backup هنا يجب ان تكون الجملة :- cd D:\BACKUP$\periodic أيضاً لاحظ أن عبارة :- لإنشاء مجلد بالتاريخ والوقت الحالي قد يلحقك بمشكلة إذا كانت الساعة أقل من 10 ، وهذا مثال على نتيجة السطر :- 20_5-_-07-12_ 1_46_01.3 لاحظ أن الساعة 1:47 لكن دقق في النتيجة لإسم المجلد يوجد فراغ قبل الرقم 1 . بالعموم ، فكرتك جميلة وقابلة للتطوير اذا اجتهدت عليها أكثر . فشكراً لك على هذه المشاركة الجميلة لفكرة نسخ إحتياطي لقاعدة البيانات من مجلد رئيسي بمجلداته الفرعية مع ضبط بعض الخصائص ..

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

اسمح لي بمداخلة أخي جو .. الآن عند فتح التقرير والرسالة أمامه ، فلن يسعك رؤية التقرير ( إن كان صفحة أو أكثر .. ) لأسباب متعددة ، منها أن التقرير في وضع المعاينة سيكون ذا خط صغير ولن تستطيع تحريك أشرطة التمرير أو تكبير صفحة التقرير - Zoom - لرؤيته بشكل واضح ، صحيح ؟؟ إذا فإن عرض التقرير أو عدمه لن يغنيك بشيء. لذا ومن باب المنطق إما أن تجعل زر الطباعة داخل التقرير ، وبهذا ستتمكن من رؤيته كاملاً وتفحصه . أو رسالة الطباعة دون الإستناد لشرط عرض التقرير ( قد يكون مفتوحاً بوضع الإخفاء مثلاً .. ) هذه وجهة نظري الغير ملزمة طبعاً 😇

أستاذنا الحبيب أبو أحمد 💐 وفقكم الله في الدارين وغفر لكم .. شكراً على التهنئه 🤗

أخي طاهر ،، بارك الله فيك ، وغفر لك ولوالديك في الدنيا والآخرة. كلامك اللطيف دلالة على معدنك الطيب 🤗 شكراً لك من القلب على تهنئتك ، وأتمنى أن نراكم قريباً بجانبنا 💐

هذا يكفيني أخي الحبيب 🤗💐

كلامك صحيح .. لم أقم بالتجربة على أرقام مختلفة .. في مديول :- Function MultiplyTime(ByVal tm As Date, ByVal factor As Long) As String Dim totalMinutes As Long totalMinutes = DateDiff("n", #12:00:00 AM#, tm) * factor MultiplyTime = Format(totalMinutes \ 60 & ":" & totalMinutes Mod 60, "hh:nn") End Function جرب على الإستدعاء من خلال الاستعلام :- SELECT MultiplyTime(#4:30#, 10) AS النتيجة

وعليكم السلام ورحمة الله وبركاته .. كمثال خطر ببالي من داخل استعلام على سبيل المثال :- SELECT Format(TimeValue("4:30") * 5, "hh:nn") AS النتيجة; أو استخدام الدالة CLng كمثال :- SELECT Format((CLng(#12/30/1899 4:30:0#*1440)*5)/1440,"Short Time") AS الناتج;

وعليكم السلام ورحمة الله وبركاته .. أخي الفاضل تحية طيبة وعطرة من القلب ,, برأيك ( العنوان و المطلوب ) = من كلمتين يكفي للشرح والتوضيح للمطلوب ؟؟؟؟؟ حتى أن المرفق لا يستند الى أي معلومة تفيد المطلوب وتوضحه راجياً منك الإفصاح والتوضيح في معطيات الموضوع لتسهيل فهم للهدف ( وخصوصاً أخوك صاحب هذا التعليق 😇 )

حفاظاً على محتوى الموضوع الجميل ، تم فتح موضوع منفصل للمشكلة التي صادفت أخونا @jo_2010 ، في هذا الرابط :-

تفضل أخي الكريم .. تعديلات وإضافة مرونة أكثر للإستخدام وتقليل التكرارات . في الدالة الرئيسية :- Public Function GetTxtHeight(annee As String, grade As String, wilaya As String, nomRapport As String) As Single Dim db As DAO.Database Dim rs As DAO.Recordset Dim hauteur As Single Set db = CurrentDb Set rs = db.OpenRecordset( _ "SELECT hauteur_rang FROM tab_hauteur_range " & _ "WHERE annee = '" & Replace(Trim(annee), "'", "''") & "' " & _ "AND grade = '" & Replace(Trim(grade), "'", "''") & "' " & _ "AND wilaya = '" & Replace(Trim(wilaya), "'", "''") & "' " & _ "AND nom_raport = '" & Replace(Trim(nomRapport), "'", "''") & "'", dbOpenSnapshot) If Not rs.EOF Then hauteur = Nz(rs!hauteur_rang, 0) * 567 Else hauteur = 0.7 * 567 End If rs.Close: Set rs = Nothing: Set db = Nothing GetTxtHeight = hauteur End Function دالة لتقليل تكرار عند فتح التقرير ، وإضافة مرونة في Tag مختلف من نفس الاستدعاء .. Public Sub ApplyHeightFromTempVars(ByVal rpt As Report, Optional ByVal tagMatch As String = "moho58") On Error GoTo SafeExit Dim h As Single Dim ctrl As Control h = Nz(TempVars!Temp_Hauteur, 0.7 * 567) For Each ctrl In rpt.Controls If ctrl.ControlType = acTextBox Then If LCase(Trim(Nz(ctrl.Tag, ""))) = LCase(tagMatch) Then ctrl.Height = h End If End If Next ctrl rpt.Section(acDetail).Height = h SafeExit: End Sub في أحدث عند النقر للأزرار :- Private Sub أمر2_Click() Dim h As Single h = GetTxtHeight(Me.annet, Me.grade1, Me.wilaya1, "rap_pv") TempVars!Temp_Hauteur = h DoCmd.OpenReport "rap_pv", acViewPreview End Sub Private Sub أمر3_Click() Dim h As Single h = GetTxtHeight(Me.annet, Me.grade1, Me.wilaya1, "rap_pv2") TempVars!Temp_Hauteur = h DoCmd.OpenReport "rap_pv2", acViewPreview End Sub في حدث عند الفتح في التقارير :- Private Sub Report_Open(Cancel As Integer) ApplyHeightFromTempVars Me ' ApplyHeightFromTempVars Me, "Foksh" تستطيع طبعاً استخدام تاج مختلف End Sub ملفك بعد التعديلات :- baseM5.zip

ولا يهمك ،، استكمالاً للسابق سأقوم بالتعديل، وإرقاق النتيجة بعد التجربة على أرض الواقع إن شاء الله 😇

أخي العزيز الأستاذ عبد اللطيف ، بداية هذه الرسالة تظهر وأعتقد لأنه يوجد لديك تطبيق واتس أب سطح المكتب .. حيث ، انظر لهذا السطر على سبيل المثال :- https://api.whatsapp.com/send/?phone=962787787573&text&type=phone_number&app_absent=0 لاحظ الرقم 0 في نهاية العنوان !! انظر لطبيعة ونوع الرسالة التي تظهر لك عندما يكون لديك تطبيق واتس اب سطح المكتب . ثم جرب وعدل 0 = 1 ، وانظر الفرق بين الرسالتين !!!! طبعاً في النهاية سيتم فتح التطبيق في حال تم تثبيته لأن له الأولوية على موقع الويب . لكن في نهاية المطاف ، لتجربة أن الكود يقوم فعلاً بتنفيذ المطلوب ، قم بحذف تطبيق الواتس اب لديك من الكمبيوتر ، وجربه ولاحظت أيضاً انه عندما لا يكون هناك ايميل ، فيظهر لك خطأ .. قم بإضافة هذا السطر في بداية حدث النقر لمربع النص الخاص بإرسال الإيميل Private Sub EMAIL_Click() If IsNull(Me.EMAIL) Or Me.EMAIL = "" Then Exit Sub

وعليكم السلام ورحمة الله وبركاته ,, فيما يخص الإيميل ، فهذه فكرة بسيطة من خلال النقر على مربع نص الإيميل على سبيل المثال :- Private Sub EMAIL_Click() Dim EmailAdd As String Dim GmailURL As String EmailAdd = Me.EMAIL.Value If Not IsValidEmails(EmailAdd) Then MsgBox "عنوان البريد الإلكتروني غير صالح", vbExclamation + vbMsgBoxRight, "" Exit Sub End If GmailURL = "https://mail.google.com/mail/?view=cm&fs=1&to=" & EmailAdd Application.FollowHyperlink GmailURL End Sub Function IsValidEmails(EMAIL As String) As Boolean Dim regex As Object Set regex = CreateObject("VBScript.RegExp") regex.Pattern = "^[\w-\.]+@([\w-]+\.)+[\w-]{2,4}$" regex.IgnoreCase = True IsValidEmails = regex.Test(EMAIL) End Function والطلب الثاني ، وهو فتح واتس أب ويب على دردشة محددة للرقم الذي تم النقر عليه ، حذح محاولتي البسيطة ( مشتقة من أحد ملفاتي سابقاً ) .. Private Sub MOB_Click() Dim WhatsURL As String Dim PhoneNum As String PhoneNum = Me.MOB.Value PhoneNum = CleanPhoneNum(PhoneNum) If PhoneNum = "" Then MsgBox "رقم الهاتف غير صالح", vbExclamation + vbMsgBoxRight, "" Exit Sub End If WhatsURL = "https://wa.me/" & PhoneNum Application.FollowHyperlink WhatsURL End Sub Function CleanPhoneNum(phone As String) As String Dim i As Integer Dim result As String result = "" For i = 1 To Len(phone) If IsNumeric(Mid(phone, i, 1)) Then result = result & Mid(phone, i, 1) End If Next i If Left(result, 2) = "00" Then result = Right(result, Len(result) - 2) ElseIf Left(phone, 1) = "+" Then result = Right(result, Len(result) - 1) End If CleanPhoneNum = result End Function