ابوخليل قام بنشر نوفمبر 8, 2016 مشاركة قام بنشر نوفمبر 8, 2016 بسم الله الرحمن الرحيم احبتي الكرام السلام عليكم ورحمة الله وبركاته وبعد : وجدت لكم دالة تأخذ التاريخ والوقت الدولي من الانترنت ، مع شروحات للاكواد وافية كثير من الاخوة يحتاجون هذه الدالة خاصة الذين يعتمدون على جهاز واحد ، وذلك من اجل سد ثغرات احتمال التلاعب بوقت وتاريخ الجهاز من الشروط وجود خدمة الانترنت ، واعتقد في اليوم الحاضر اصبح من الضروريات التي لا يتصور الاستغناء عنها هذه الدالة جميلة جدا تجلب التاريخ والوقت الدولي مع امكانية مراعاة فارق التوقيت حول العالم الدالة : InternetTime()' التاريخ والوقت في جرينتش InternetTime(3)' في مكة المكرمة InternetTime(2)' في مصر امكانية عمل التنسيقات عليه بالضبط تماما كما نتعامل مع الدالة()Date أو ()NOW فهذا التنسيق يعطينا الوقت في مكة Format(InternetTime(3);"hh:mm:ss AM/PM") وكما تلاحظون ان الارقام التي بين الاقواس تعني فارق الزمن وهذه هي الوحدات النمطية : Function InternetTime(Optional GMTDifference As Integer) As Date '----------------------------------------------------------------------------------- 'This function returns the Greenwich Mean Time retrieved from an internet server. 'You can use the optional argument GMTDifference in order to add (or subtract) 'an hour from the GMT time. For Example if you call the function as: '=InternetTIme(2) it will return the (local) hour GMT + 2. Note that the 'GMTDifference variable is an integer number. 'Written by: Christos Samaras 'Date: 25/09/2013 'Last Updated: 20/11/2013 'e-mail: xristos.samaras@gmail.com 'site: http://www.myengineeringworld.net 'Declaring the necessary variables. Dim Request As Object Dim ServerURL As String Dim Results As String Dim NetDate As String Dim NetTime As Date Dim LocalDate As Date Dim LocalTime As Date 'Check if the time difference is within the accepted range. If GMTDifference < -12 Or GMTDifference > 14 Then Exit Function End If 'The server address. ServerURL = "http://www.timeanddate.com/worldclock/fullscreen.html?n=2" 'Build the XMLHTTP object and check if was created successfully. On Error Resume Next Set Request = CreateObject("Microsoft.XMLHTTP") If Err.Number <> 0 Then Exit Function End If On Error GoTo 0 'Create the request. Request.Open "GET", ServerURL, False, "", "" 'Send the request to the internet server. Request.Send 'Based on the status node result, proceed accordingly. If Request.readyState = 4 Then 'If the request succeed, the following line will return 'something like this: Mon, 30 Sep 2013 18:33:23 GMT. Results = Request.getResponseHeader("date") 'Use the Mid function to get something like: 30 Sep 2013 18:33:23. Results = Mid(Results, 6, Len(Results) - 9) 'Use the Left and Right function to distinguish the date and time. NetDate = Left(Results, Len(Results) - 9) '30 Sep 2013 NetTime = Right(Results, 8) '18:33:23 'Convert the date into a valid Excel date 30 Sep 2013 -> 30/9/2013. 'Required for countries that have some non-Latin characters at their alphabet (Greece, Russia, Serbia etc.). LocalDate = ConvertDate(NetDate) 'Add the hour difference to the retrieved GMT time. LocalTime = NetTime + GMTDifference / 24 'Return the local date and time. InternetTime = LocalDate + LocalTime End If 'Release the XMLHTTP object. Set Request = Nothing End Function Function ConvertDate(strDate As String) As Date '------------------------------------------------------------------------- 'This function converts the input date into a valid Excel date. 'For example the 30 Sep 2013 becomes 30/9/2013. 'Required for countries that have non-Latin characters at their alphabet. 'Written by: Christos Samaras 'Date: 25/09/2013 'e-mail: xristos.samaras@gmail.com 'site: http://www.myengineeringworld.net '------------------------------------------------------------------------- 'Declaring the necessary variables. Dim MyMonth As Integer 'Check the month and convert it to number. Select Case UCase(Mid(strDate, 4, 3)) Case "JAN": MyMonth = 1 Case "FEB": MyMonth = 2 Case "MAR": MyMonth = 3 Case "APR": MyMonth = 4 Case "MAY": MyMonth = 5 Case "JUN": MyMonth = 6 Case "JUL": MyMonth = 7 Case "AUG": MyMonth = 8 Case "SEP": MyMonth = 9 Case "OCT": MyMonth = 10 Case "NOV": MyMonth = 11 Case "DEC": MyMonth = 12 End Select 'Rebuild the date. ConvertDate = DateValue(Right(strDate, 4) & "/" & MyMonth & "/" & Left(strDate, 2)) End Function وتطبيق المقال بهذا المثال : db2.rar 4 رابط هذا التعليق شارك More sharing options...
محمد ايمن قام بنشر نوفمبر 8, 2016 مشاركة قام بنشر نوفمبر 8, 2016 جزاك الله كل خير رابط هذا التعليق شارك More sharing options...
محمد سلامة قام بنشر نوفمبر 9, 2016 مشاركة قام بنشر نوفمبر 9, 2016 شكرا استاذنا ابوخليل رابط هذا التعليق شارك More sharing options...
ابوخليل قام بنشر نوفمبر 9, 2016 الكاتب مشاركة قام بنشر نوفمبر 9, 2016 استدراك وتنويه : هنا موضوع يتحدث عن الفكرة سبقنا الاستاذ محمد عصام مشكورا وارفق فيه مثالا جيدا 2 رابط هذا التعليق شارك More sharing options...
الحلبي قام بنشر نوفمبر 10, 2016 مشاركة قام بنشر نوفمبر 10, 2016 استادنا / ابو خليل حياك الله ياسلام عليك ما هدا الجمال ساقوم بالتطبيق ونعرض علي حضرتك النتيجة ان شاء الله ولا انسي مجهود الاستاد/ ابا جودي هنا في تقديمه للمثال الاول انت مبدع استاد / ابو خليل وربنا يبارك فيك كل تقدير واحترام لك 1 رابط هذا التعليق شارك More sharing options...
ابو جودي قام بنشر نوفمبر 10, 2016 مشاركة قام بنشر نوفمبر 10, 2016 في 11/9/2016 at 15:05, ابوخليل said: استدراك وتنويه : هنا موضوع يتحدث عن الفكرة سبقنا الاستاذ محمد عصام مشكورا وارفق فيه مثالا جيدا العفو منك استاذى الحبيب ووالدى الكريم ما انا الا طالب علم رفع الله قدركم ودرجاتكم فى الدنيا وفى الجنان ان شاء الله جزاكم الله خيرا رابط هذا التعليق شارك More sharing options...
ابو جودي قام بنشر نوفمبر 10, 2016 مشاركة قام بنشر نوفمبر 10, 2016 في 11/9/2016 at 16:00, حلبي said: استادنا / ابو خليل حياك الله ياسلام عليك ما هدا الجمال ساقوم بالتطبيق ونعرض علي حضرتك النتيجة ان شاء الله ولا انسي مجهود الاستاد/ ابا جودي هنا في تقديمه للمثال الاول انت مبدع استاد / ابو خليل وربنا يبارك فيك كل تقدير واحترام لك جزاكم الله خيرا اخى الحبيب على ذكركم واطرائكم بالرغم من المبالغة من قبلكم لجود اخلاقكم فلم اقم باى مجهود يذكر رابط هذا التعليق شارك More sharing options...
الحلبي قام بنشر نوفمبر 11, 2016 مشاركة قام بنشر نوفمبر 11, 2016 الاستاد / ابو خليل قمت بتطبيق المثال عندي والحمد الله كل شئ ضبط معي ولكن سؤالي : ما سبب ثقل فتح النمودج اجد انه يأخد بعض الوقت اثناء الفتح هل بسبب انه يأخد الوقت من النت؟ وعلي اي حال فهو قام بحل مشكلة كبيرة لدي والفضل لله ثم لكم دائما استادي/ ابو خليل تحل مشاكلي وتكون خير عونا لي استاد / ابا جودي هدا ليس باطراء ولكن هدا حقك عليَ انت حد محترم جدا كل احترام وتقدير لكما 1 رابط هذا التعليق شارك More sharing options...
ابو جودي قام بنشر نوفمبر 11, 2016 مشاركة قام بنشر نوفمبر 11, 2016 9 ساعات مضت, حلبي said: الاستاد / ابو خليل قمت بتطبيق المثال عندي والحمد الله كل شئ ضبط معي ولكن سؤالي : ما سبب ثقل فتح النمودج اجد انه يأخد بعض الوقت اثناء الفتح هل بسبب انه يأخد الوقت من النت؟ وعلي اي حال فهو قام بحل مشكلة كبيرة لدي والفضل لله ثم لكم دائما استادي/ ابو خليل تحل مشاكلي وتكون خير عونا لي استاد / ابا جودي هدا ليس باطراء ولكن هدا حقك عليَ انت حد محترم جدا كل احترام وتقدير لكما دزاكم الله خيرا اخى الحبيب تحية عطرة طيبة مباركة الملف عندى يفتح ولا يتعدى ةقت فتحه وتحميله للوقت اكثر من ثلاث ثوانى باقصى تقدير قد تكون سرعة الانترنت لها تأثير رابط هذا التعليق شارك More sharing options...
عاشق الرقي قام بنشر نوفمبر 30, 2016 مشاركة قام بنشر نوفمبر 30, 2016 تسلم ايدك يا أستاذ أبو خليل ولا يهون الجميع في هذا الصرح بوركتم جميعا رابط هذا التعليق شارك More sharing options...
m.jafer قام بنشر ديسمبر 4, 2016 مشاركة قام بنشر ديسمبر 4, 2016 الفكرة غير عملية فقد يفصل المستخدم الانترنت ماهو حل هذه المشكلة الانترنت عندنا لا يسمح الا بالايميل اوتلوك فقط رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان