اذهب الي المحتوي
بحث مخصص من جوجل فى أوفيسنا
Custom Search

البحث في الموقع

Showing results for tags 'درس'.



More search options

  • Search By Tags

    اكتب الكلمات المفتاحيه بينها علامه الفاصله
  • Search By Author

نوع المحتوي


الاقسام

  • الترحيب
  • قسم تطبيقات و لغات مايكروسوفت
    • المنتدى المفتوح
    • منتدى الاكسيل Excel
    • قسم الأكسيس Access
    • دعم أنظمة الويندوز المختلفة
    • منتدي الوورد Word
    • منتدى الباوربوينت
    • منتدى الاوتلوك Outlook
    • منتدى الفيزيو Visio
    • منتدي مايكروسوفت بروجكت Ms Project
    • منتدى الفرنت بيج العام Frontpage
    • انفو باث InfoPath
    • وان نوت One Note
    • الناشر بابليشر Publisher
    • Communicator
    • Expression Web
    • SQL Server
    • VB.net
    • C#.net
  • الغات و أدوات البرمجة الأخرى
    • حوارات الويب العامة
    • Delphi
    • PHP
    • برمجة الاندرويد
  • أقسام الإدارة و إدارة المشاريع و تطبيقاتها
    • إدارة المشاريع
    • إدارة الجودة
    • القيادة و تنمية المهارات
    • Primavera Enterprise
    • Primavera 3.1
  • البحث العلمي و علوم البيانات
    • مناهج البحث العلمي
    • علم الإحصاء
    • الذكاء الإصطناعي و التنقيب فى البيانات
    • Orange
    • R
    • SPSS
    • Python
  • القسم العام
    • نرحب بزوار الموقع

الاقسام

  • VBA Code Library
  • قسم الإكسيل
  • قسم الأكسيس
  • قسم الوورد
  • Project Management
  • Self development التطويرالذاتي
  • EFQM & DGEP
  • معلومات مفيدة
  • أدوات عامة

مدونات

  • M-Taher's Blog
  • Officena
  • مدونة محمد طاهر
  • اا الفاروق اا
  • ‎مدونة أخبار التكنولوجيا
  • M-Taher's Blog
  • يحيى حسين's Blog
  • خبور خير's Blog
  • Dr. AbdelMalek Abu Sheikh's Blog
  • m.hindawi's Blog
  • احمدزمان's Blog
  • الحسامي
  • مدونة أ / محمد صالح
  • yahiaoui's Blog
  • عبدالله المجرب's Blog
  • صيد الخواطر
  • حمادة عمر مدونة
  • مدونة جعفر
  • مدونة عادل حنقي
  • مجدى يونس: لمسة وفاء لمنتدى اوفيسنا
  • Excel Expert Financial&Accounting
  • مدونة اعمال ايقونات الماس لمنتدى اوفيسنا
  • Shivan Rekany
  • رقائق فى دقائق

ابحث عن النتائج فى ......

ابحث عن النتائج التي تحوي ....


تاريخ الانشاء

  • بدايه

    End


اخر تحديث

  • بدايه

    End


Filter by number of...

انضم

  • بدايه

    End


مجموعه


Job Title


بلد الإقامة


الإهتمامات


AIM


MSN


Website URL


ICQ


Yahoo


Jabber


Skype

تم العثور علي 7 نتائج

  1. السلام عليكم, في سنة 2017 قمت بكتابة كلاس بسيط لحماية برنامجي ولضمان برنامجي لا يعمل في غير كومبيوترات في حاله بيعه. مميزات الكلاس: 1- قفل قاعدة البيانات على ( رقم الهارد , البروسيسور , المذربورد , الماك أدريس ) 2- (استحاله) فك النماذج والتقارير في حال عدم تجاوزك لنموذج ( تسجيل الدخول ) ببساطة ستقول يمكنني العثور على باسورد القاعدة داخل الجدول ( الطريقة المعتادة لدينا جميعا في انشاء نموذج تسجيل دخول ). قبل كل شي ليكن لدينا مثلا جدول اسمة ( tbl_Login ) و نموذج اسمه ( frm_Login ) الجدول لتخزين اسم المستخدم وكلمة المرور والنموذج لعمل تسجيل الدخول عند ذهابنا للجدول ( tbl_Login ) ، سوف نحصل على باسورد مشفر من الجدول لو كان الباسورد مثلا ( 313 ) فإنك ستحصل على ( 701D6068 ) 2- عندما نقوم بتسجيل الدخول في النموذج سيقوم البرنامج بأخذ كلمة السر المدخلة ويقوم بتشفيرها ثم يقوم بمطابقتها مع الباسورد الموجود في الجدول اذا كان الباسورد المُدخل يطابق الجدول سيكتب قيمة معينة runtime ويقوم بازالة جميع القيود من النماذج والتقارير. اولا: كلاس الحماية Option Compare Database '----------------------------------------------------- ' Protection Module Coded By Hassanein Hirz Aldeen (SEMO.Pa3x) ' Date 26/11/2017 ' All rights reserved. copyright © 2017 '----------------------------------------------------- Public SEMO As String Function SEMO_GET() SEMO = SEMO SEMO_GET = SEMO End Function Function PR() As Boolean PR = False 'False=Disabled , True=Enabled End Function Function HWND_ID() HWND_ID = "3C3F4825" 'Your HWID End Function Function HWND_MSG() HWND_MSG = "...ليست لديك صلاحيات كافية لإستخدام هذا الاجراء" End Function Function KEY_ENDE() KEY_ENDE = "PA$X" End Function Function HWND_GET() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_GET = disk.volumeserialnumber Exit For End If Next End Function Function HWND_PROTECTION() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_PROTECTION = disk.volumeserialnumber Exit For End If Next If HWND_ID = HWND_PROTECTION Then HWND_PROTECTION = "True" Else HWND_PROTECTION = "False" End If End Function 'Code contained within module named mdlforencryptionanddecryption Public Function XORDecryption(CodeKey As String, DataIn As String) As String Dim arkdata1 As Long Dim strDataOut As String Dim intXOrValue1 As Integer Dim intXOrValue2 As Integer For arkdata1 = 1 To (Len(DataIn) / 2) 'The first value to be XOr-ed comes from the data to be encrypted intXOrValue1 = Val("&H" & (Mid(DataIn, (2 * arkdata1) - 1, 2))) 'The second value comes from the code key intXOrValue2 = Asc(Mid(CodeKey, ((arkdata1 Mod Len(CodeKey)) + 1), 1)) strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2) Next arkdata1 XORDecryption = strDataOut End Function Public Function XOREncryption(CodeKey As String, DataIn As String) As String Dim arkdata1 As Long Dim strDataOut As String Dim temp As Integer Dim tempstring As String Dim intXOrValue1 As Integer Dim intXOrValue2 As Integer For arkdata1 = 1 To Len(DataIn) 'The first value to be XOr-ed comes from the data to be encrypted intXOrValue1 = Asc(Mid$(DataIn, arkdata1, 1)) 'The second value comes from the code key intXOrValue2 = Asc(Mid$(CodeKey, ((arkdata1 Mod Len(CodeKey)) + 1), 1)) temp = (intXOrValue1 Xor intXOrValue2) tempstring = Hex(temp) If Len(tempstring) = 1 Then tempstring = "0" & tempstring strDataOut = strDataOut + tempstring Next arkdata1 XOREncryption = strDataOut End Function الاستخدام لكل النماذج والتقارير اكتب في حدث Form_Load Option Compare Database Private Sub Form_Load() On Error Resume Next If HWND_PROTECTION = "False" Then MsgBox HWND_MSG, vbCritical, "عملية خاطئة" For i = 0 To Controls.Count - 1 Dim X As Control Set X = Me.Controls.Item(i) X.Visible = False Next DoCmd.Close DoCmd.CloseDatabase DoCmd.Quit End If If Protection.SEMO_GET = "SEMO" = False Then MsgBox HWND_MSG, vbCritical, "عملية خاطئة" For i = 0 To Controls.Count - 1 Dim XS As Control Set XS = Me.Controls.Item(i) XS.Visible = False Next DoCmd.Close DoCmd.CloseDatabase DoCmd.Quit End If End Sub الان عندما تريد اعطاء القاعدة لشخص ما قم باعطاءه اولا ملف الـ VBS هذا '----------------------------------------------------- ' ReCoded By Hassanein Hirz Aldeen (SEMO.Pa3x) ' Date 26/11/2017 ' All rights reserved. copyright © 2017 '----------------------------------------------------- ' Get clipboard text Set objHTML = CreateObject("htmlfile") Set Ws = CreateObject("WScript.Shell") Clipboardtext = objHTML.ParentWindow.ClipboardData.GetData("text") sText = HWND_GET 'Set Clipboard Ws.Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True MsgBox "Copied!" Function HWND_GET() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_GET = disk.volumeserialnumber Exit For End If Next End Function وظيفة هذا الملف يقوم باستخراج ( رقم الهارد , البروسيسور , المذربورد , الماك أدريس ) ثم ينسخه بعدما يشغله سيقوم العميل باعطاءك هذا الرقم لكي تقوم انت بدورك بوضعه داخل الكلاس في المنطقة Function HWND_ID() HWND_ID = "Your HWID" End Function استبدل كلمة ( Your HWID ) بالرقم الذي سيعطيه لك العميل. ثم بعد ذلك قم بحفظ القاعدة بصيغة ( ACCDE ) واتحدا اي شخص يفتحها مرة اخرى: لكي تفتح النماذج والتقارير عليك بتخطي نموذج تسجيل الدخول ارفقت لكم قاعدة محمية وقاعدة بدون حماية مع ملف الـ VBS الذي يستخرج ارقام قطع الجهاز ويقوم بنسخها،، اتمنى لكم الفائدة جميعاً اهداء الموضوع الى مُعلمي الرائع @jjafferr حسنين Login_SEMO_Pa3x.rar
  2. السلام عليكم ورحمة الله وبركاته. كنت قد طرحت سابقا موضوع لتشغيل ملفات الصوت في الاكسس وكان الموضوع يتناول تشغيل الملفات التي تكون بصيغة WAV حصرا رابط الموضوع: درس اليوم هو حول تشغيل ملفات الصوت بصيغة MP3 في الاكسس. الدوال المستخدمة: mciSendStringA GetShortPathNameA بعض الحقوق لأصحابها اتمنى منكم الدعاء لي ولوالدي. حسنين Mp3Sounds_SEMO_Pa3x.accdb
  3. السلام عليكم, في السابق كنت استخدم خطوط معينة في برامجي وعند اعطاء البرنامج للعميل لاتظهر الخطوط التي قمت باستخدامها بل يظهر بمكانها الخط ( Arial ) وهذه مُشكلة. كت في وقتها الجأ الى ان اضع الخط بجانب قاعدة البيانات وفي داخل قاعدة البيانات اقوم بعمل تحقق لمجلد Fonts والبحث عن الخط في بداية تشغيل القاعدة, فإن لم يجده يعي رسالة للعميل بان الط مفقود وعليه ان يقوم بتثبيته من جانب البرنامج. بحثت طويلاً في الانترنت عن تثبيت خط من الاكسس فقط بدون مساعدة عامل خارجي ولكن لم اصل لنتيجة. اليوم بحمد الله قمت بحل المشكلة بإستخدام ( Visual .NET ) قمت بكتابة اداة بسيطة وظيفتها تثبيت الخط. يتم تمرير براميتر لها وهي بدورها ستقوم بتثبيته الدوال المستخدمة: AddFontResource CreateScalableFontResource ShellExecuteA للمزيد من المعلومات ، اضغط على اسم الدالة ارفقت لكم المصادر من MSDN شرح بسيط لمن لم يعرف ماذا اقصد بتثبيت الخط واستخدام الخط وانه لن يظهر في حال كان العميل لا يملكه. قمت بارفاق قاعدة بيانات لكم كـ مثال للشرح مع الخط المستخدم مع الاداة. شرح الاستعمال: يجب ان تكون الاداة ( SEMO_RegisterFont.exe ) هي والخط الذي سوف تستخدمه بجانب قاعدة البيانات. افتح برنامجك وضع فيه هذا الاجراء. Sub RegisterFont(nFont) Dim strExe As String Dim strArg As String strExe = CurrentProject.Path & "\" & "SEMO_RegisterFont.exe" strArg = "/SEMO/" & nFont ShellExecute 0, "runas", strExe, strArg, vbNullString, SW_SHOWNORMAL End Sub في الاستدعاء اي في الحدث Form_Current RegisterFont "DroidSansArabic.ttf" حيث ان الـ DroidSansArabic.ttf هو اسم الخط الذي قمنا بوضعه بجانب قاعدة البيانات ملاحظة مهمة جدا: في حال كان اسم الخط يتكون من اكثر من كلمة مثل ( Droid Sans Arabic.ttf ) قم بحذف المسافات بين كلمة واخرى بحيث يصبح ( DroidSansArabic.tts ) وستعمل قاعدة البيانات التي قمت بتصميمها بشكل رائع وبالخطوط التي قمت انت بأختيارها بدون الخوف من مشكلة عدم توفر الخطوط في جهاز العميل. الشرح حصري للمنتدى وغير موجود في الانترنت. لا تشكرني الا اذا وجدت انني استحق ذلك. تم بحمد الله حسنين RegisterFont_SEMO_Pa3x.rar
  4. Option Compare Database Option Explicit Const SND_ALIAS_SYSTEMASTERISK As String = "SystemAsterisk" Const SND_ALIAS_SYSTEMDEFAULT As String = "SystemDefault" Const SND_ALIAS_SYSTEMEXCLAMATION As String = "SystemExclamation" Const SND_ALIAS_SYSTEMEXIT As String = "SystemExit" Const SND_ALIAS_SYSTEMHAND As String = "SystemHand" Const SND_ALIAS_SYSTEMQUESTION As String = "SystemQuestion" Const SND_ALIAS_SYSTEMSTART As String = "SystemStart" Const SND_ALIAS_SYSTEMWELCOME As String = "SystemWelcome" Const SND_ALIAS_YouGotMail As String = "MailBeep" ' playsound Params Const SND_LOOP = &H8 Const SND_ALIAS = &H10000 Const SND_NODEFAULT = &H2 ' silence if no sound associated with event Const SND_ASYNC = &H1 ' play async (don't freeze program while sound is playing) Private Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long Private Sub Form_Close() PlaySound vbNullString, ByVal 0&, SND_NODEFAULT End Sub Private Sub Form_Load() PlaySound CurrentProject.Path & "\" & "DB_FILES\About.wav", vbNull, SND_ALIAS Or SND_NODEFAULT Or SND_ASYNC Or SND_LOOP End Sub اي سؤال انا حاضر، اتمنى الفائدة للجميع.
  5. السلام عليكم. بعد جهد كبير وسهر ليالي كثيرة, وكلها محاولات بائت بالفشل لربط الـ Visual Studio .NET وقراءة البيانات بالاكسس وكانت متمثلة بمكتبة dll او tlb للاسف كانت هنالك عوائق ومنها لكي يتم استخدام مكتبة من نوع tlb كان يجب اعطائها صلاحيات مسؤول لكي تتمكن من تسجيل هذه المكتبة في HKEY_CLASSES_ROOT في الريجستري. وتستخدمها على شكل References وفي حال استخدام مكتبة من نوع dll كان يتطلب استخدام دالة LoadLibraryA وهذه سيعتبرها الانتي فايروس كـ ملف مريب خصوصا لانها تقوم بتحميل المكتبة في الذاكرة وبدون توقيع رقمي..الخ اليوم قمت ببرمجة شيء مختلف ومميز عبارة عن تطبيق صغير بلغة NET. يتم تمرير البيانات من الاكسس لهذه التطبيق لكي يقوم بعدها الاكسس باقتناص المخرجات من التطبيق بواسطة الي remote shell ثم عرضها في الاكسس مرة اخرى وكان التطبيق على تحويل التاريخ الميلادي الى هجري لكن هذه المرة بصورة ادق وافضل. كما نعرف جميعنا ان التاريخ الهجري يكون غير مضبوط زيادة يوم او يومين او نقصان يوم او يومين او لا يوجد زيادة او نقصان لذلك قمت بوضع ComboBox لهذا الأمر.. اكتب التاريخ الميلادي في الحقل الاول ثم اكتب فارق الايام ان وجدت زيادة او نقصان او اتركها صفر كما هي او لم يوجد تغيير السورس كود التطبيق بلغة NET. لمن يريده. Module SEMO_Pa3x '-------------------------------------------------------- 'c0ded bY : SEMO.Pa3x 'skype : security.najaf 'facebook : https://www.facebook.com/Nisr.Aln3jaf 'gmail : isec2090@gmail.com 'last edit : 26/4/2019 '-------------------------------------------------------- Sub Main() For Each arg As String In My.Application.CommandLineArgs If arg.StartsWith("/SEMO/") Then Dim rep As String Dim splt() As String rep = arg.Replace("/SEMO/", "") splt = Split(rep, ",") Dim GET_date, GET_args As String GET_date = splt(0) GET_args = splt(1) Dim ConvertToDate As DateTime ConvertToDate = DateTime.Parse(GET_date) DateFormating(ConvertToDate.AddDays(GET_args)) DateConvert(ConvertToDate.AddDays(GET_args)) Console.WriteLine(ArabicWeekdayString(Weekday(GET_date)) & "," & LongDateString) End If Next End Sub Public LongDateString As String = String.Empty '#Region " DateConverter (dateValue As String) As String " #Region " DateConverter (dateValue As String) As String " Public Function DateConvert(ByVal dateValue As String) As String LongDateString = "" ' الاحتفاظ بالإعدادت الحالية Dim currentCulture As Globalization.CultureInfo = Threading.Thread.CurrentThread.CurrentCulture Dim con As String = "" If DateFormating(dateValue) <> "" Then dateValue = DateFormating(dateValue) '---------------------------------- Dim y As String = IIf(dateValue <> "", dateValue.Split("/")(2), "") Dim mmm() As String If y > "1300" And y < "1451" Then con = GetGregorianDate(dateValue) mmm = Split(GetGregorianDate(dateValue), "/") LongDateString = ArabicWeekdayString(Weekday(GetGregorianDate(dateValue))) & " " & mmm(0) & " " & GregorianMonthString(Val(mmm(1))) & ", " & mmm(2) End If If y > "1883" And y < "2029" Then con = GetHijriDate(dateValue) mmm = Split(con, "/") LongDateString = mmm(0) & "," & HiriMonthString(Val(mmm(1))) & "," & mmm(2) & "H" End If End If ' إستعادة الإعدادت Threading.Thread.CurrentThread.CurrentCulture = currentCulture Return con End Function #End Region #Region " GetHijriDate(GregorianDate As String) As String " Private Function GetHijriDate(ByVal GregorianDate As String) As String Try Threading.Thread.CurrentThread.CurrentCulture = New Globalization.CultureInfo("ar-eg") Dim hijriDate As String = String.Empty 'Start Date is 10-31-1883 Dim DaysPan As Integer = DateDiff(DateInterval.Day, New System.DateTime(1883, 10, 31), CDate(GregorianDate)) + 1 Dim i As Integer = 0 Do While (DaysPan > 29 + Val(UmmUlquraHijriMonths.Chars(i))) DaysPan = DaysPan - 29 - Val(UmmUlquraHijriMonths.Chars(i)) i = i + 1 Loop hijriDate = Format$(DaysPan, "00") + "/" + Format((i Mod 12) + 1, "00") + "/" + CStr(1301 + (i \ 12)) Return hijriDate Catch ex As Exception ' MessageBox.Show("تأكد من التاريخ الميلادي.", "خطأ في التاريخ الميلادي", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign Or MessageBoxOptions.RtlReading) Return Nothing End Try End Function #End Region #Region " GetGregorianDate(HijriDate As String) As Date " Private Function GetGregorianDate(ByVal HijriDate As String) As String Try Threading.Thread.CurrentThread.CurrentCulture = New Globalization.CultureInfo("ar-eg") Dim gregorianDate As String = String.Empty Dim MonthsPan As Integer MonthsPan = (12 * (CInt(Mid(HijriDate, 7, 4)) - 1301)) + CInt(Mid(HijriDate, 4, 2)) Dim TempDaysPan As Integer Dim i As Integer For i = 0 To MonthsPan - 2 TempDaysPan = TempDaysPan + 29 + Val(UmmUlquraHijriMonths.Chars(i)) Next i If CInt(Mid(HijriDate, 1, 2)) > 29 + Val(UmmUlquraHijriMonths.Chars(i)) Then ' MessageBox.Show("رقم اليوم لهذا الشهر يجب أن لا يتجاوز 29", "خطأ اليوم الشهري للتاريخ الهجري", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign Or MessageBoxOptions.RtlReading) Return Nothing Else TempDaysPan = TempDaysPan + CInt(Mid(HijriDate, 1, 2)) End If 'Start Date is 10-31-1883 gregorianDate = CStr(DateAdd(DateInterval.Day, TempDaysPan - 1, New System.DateTime(1883, 10, 31))) Return gregorianDate Catch ex As Exception ' MessageBox.Show("تأكد من التاريخ الهجري.", "خطأ في التاريخ الهجري", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign Or MessageBoxOptions.RtlReading) Return Nothing End Try End Function #End Region #Region " UmmUlquraHijriMonths " 'UmmUlquraHijriMonths Private Function UmmUlquraHijriMonths() As String Dim HijriMonthSequence As String = "" 'Create the Months data from 1301H to 1450H - (150years) HijriMonthSequence += "111010010011" 'Year 1301H HijriMonthSequence += "011101001001" 'Year 1302H HijriMonthSequence += "011101100100" 'Year 1303H HijriMonthSequence += "101101101010" 'Year 1304H HijriMonthSequence += "010101110101" 'Year 1305H HijriMonthSequence += "010010110110" 'Year 1306H HijriMonthSequence += "101001010110" 'Year 1307H HijriMonthSequence += "101101001010" 'Year 1308H HijriMonthSequence += "110110100100" 'Year 1309H HijriMonthSequence += "110111010010" 'Year 1310H HijriMonthSequence += "010111011001" 'Year 1311H HijriMonthSequence += "001011011100" 'Year 1312H HijriMonthSequence += "100101011101" 'Year 1313H HijriMonthSequence += "010010101101" 'Year 1314H HijriMonthSequence += "101001010101" 'Year 1315H HijriMonthSequence += "101101001010" 'Year 1316H HijriMonthSequence += "101101101001" 'Year 1317H HijriMonthSequence += "010101110100" 'Year 1318H HijriMonthSequence += "100101110110" 'Year 1319H HijriMonthSequence += "010010110111" 'Year 1320H HijriMonthSequence += "001001010111" 'Year 1321H HijriMonthSequence += "010100101011" 'Year 1322H HijriMonthSequence += "011010010101" 'Year 1323H HijriMonthSequence += "011011001010" 'Year 1324H HijriMonthSequence += "101011010101" 'Year 1325H HijriMonthSequence += "010101011011" 'Year 1326H HijriMonthSequence += "001001011101" 'Year 1327H HijriMonthSequence += "100100101101" 'Year 1328H HijriMonthSequence += "110010010101" 'Year 1329H HijriMonthSequence += "110101001010" 'Year 1330H HijriMonthSequence += "111010100101" 'Year 1331H HijriMonthSequence += "011011010010" 'Year 1332H HijriMonthSequence += "101011010101" 'Year 1333H HijriMonthSequence += "010101011010" 'Year 1334H HijriMonthSequence += "101010101011" 'Year 1335H HijriMonthSequence += "010101001011" 'Year 1336H HijriMonthSequence += "011010100101" 'Year 1337H HijriMonthSequence += "011101010010" 'Year 1338H HijriMonthSequence += "101110101001" 'Year 1339H HijriMonthSequence += "001101110100" 'Year 1340H HijriMonthSequence += "101010110110" 'Year 1341H HijriMonthSequence += "010101010110" 'Year 1342H HijriMonthSequence += "101010101010" 'Year 1343H HijriMonthSequence += "110101010010" 'Year 1344H HijriMonthSequence += "110110101001" 'Year 1345H HijriMonthSequence += "010111010100" 'Year 1346H HijriMonthSequence += "101011101010" 'Year 1347H HijriMonthSequence += "010011011101" 'Year 1348H HijriMonthSequence += "001001101110" 'Year 1349H HijriMonthSequence += "100100101110" 'Year 1350H HijriMonthSequence += "101010100110" 'Year 1351H HijriMonthSequence += "110101010100" 'Year 1352H HijriMonthSequence += "110110101010" 'Year 1353H HijriMonthSequence += "010110110101" 'Year 1354H HijriMonthSequence += "001010110110" 'Year 1355H HijriMonthSequence += "100100110111" 'Year 1356H HijriMonthSequence += "010010011011" 'Year 1357H HijriMonthSequence += "101001001011" 'Year 1358H HijriMonthSequence += "101100100101" 'Year 1359H HijriMonthSequence += "101101010100" 'Year 1360H HijriMonthSequence += "101101101010" 'Year 1361H HijriMonthSequence += "010101101101" 'Year 1362H HijriMonthSequence += "010010101101" 'Year 1363H HijriMonthSequence += "101001010101" 'Year 1364H HijriMonthSequence += "110100100101" 'Year 1365H HijriMonthSequence += "111010010010" 'Year 1366H HijriMonthSequence += "111011001001" 'Year 1367H HijriMonthSequence += "011011010100" 'Year 1368H HijriMonthSequence += "101011101010" 'Year 1369H HijriMonthSequence += "010101101011" 'Year 1370H HijriMonthSequence += "010010101011" 'Year 1371H HijriMonthSequence += "011010010101" 'Year 1372H HijriMonthSequence += "101101001001" 'Year 1373H HijriMonthSequence += "101110100100" 'Year 1374H HijriMonthSequence += "101110110010" 'Year 1375H HijriMonthSequence += "010110110101" 'Year 1376H HijriMonthSequence += "001010111010" 'Year 1377H HijriMonthSequence += "100101011011" 'Year 1378H HijriMonthSequence += "010010101011" 'Year 1379H HijriMonthSequence += "010101010101" 'Year 1380H HijriMonthSequence += "011010110010" 'Year 1381H HijriMonthSequence += "011011011001" 'Year 1382H HijriMonthSequence += "001011101100" 'Year 1383H HijriMonthSequence += "100101101110" 'Year 1384H HijriMonthSequence += "010010101110" 'Year 1385H HijriMonthSequence += "101001010110" 'Year 1386H HijriMonthSequence += "110100101010" 'Year 1387H HijriMonthSequence += "110101010101" 'Year 1388H HijriMonthSequence += "010110101010" 'Year 1389H HijriMonthSequence += "101010110101" 'Year 1390H HijriMonthSequence += "010010111011" 'Year 1391H HijriMonthSequence += "001001011011" 'Year 1392H HijriMonthSequence += "100100101011" 'Year 1393H HijriMonthSequence += "101010010101" 'Year 1394H HijriMonthSequence += "101101001010" 'Year 1395H HijriMonthSequence += "101110100101" 'Year 1396H HijriMonthSequence += "010110101010" 'Year 1397H HijriMonthSequence += "101010110101" 'Year 1398H HijriMonthSequence += "010101010110" 'Year 1399H HijriMonthSequence += "101010010110" 'Year 1400H HijriMonthSequence += "110101001010" 'Year 1401H HijriMonthSequence += "111010100101" 'Year 1402H HijriMonthSequence += "011101010010" 'Year 1403H HijriMonthSequence += "011011101001" 'Year 1404H HijriMonthSequence += "001101101010" 'Year 1405H HijriMonthSequence += "101010101101" 'Year 1406H HijriMonthSequence += "010101010101" 'Year 1407H HijriMonthSequence += "101010100101" 'Year 1408H HijriMonthSequence += "101101010010" 'Year 1409H HijriMonthSequence += "101110101001" 'Year 1410H HijriMonthSequence += "010110110100" 'Year 1411H HijriMonthSequence += "100110111010" 'Year 1412H HijriMonthSequence += "010011011011" 'Year 1413H HijriMonthSequence += "001001011101" 'Year 1414H HijriMonthSequence += "010100101101" 'Year 1415H HijriMonthSequence += "101010100101" 'Year 1416H HijriMonthSequence += "101011010100" 'Year 1417H HijriMonthSequence += "101011101010" 'Year 1418H HijriMonthSequence += "010101101101" 'Year 1419H HijriMonthSequence += "010010111101" 'Year 1420H HijriMonthSequence += "001000111101" 'Year 1421H HijriMonthSequence += "100100011101" 'Year 1422H HijriMonthSequence += "101010010101" 'Year 1423H HijriMonthSequence += "101101001010" 'Year 1424H HijriMonthSequence += "101101011010" 'Year 1425H HijriMonthSequence += "010101101101" 'Year 1426H HijriMonthSequence += "001010110110" 'Year 1427H HijriMonthSequence += "100100111011" 'Year 1428H HijriMonthSequence += "010010011011" 'Year 1429H HijriMonthSequence += "011001010101" 'Year 1430H HijriMonthSequence += "011010101001" 'Year 1431H HijriMonthSequence += "011101010100" 'Year 1432H HijriMonthSequence += "101101101010" 'Year 1433H HijriMonthSequence += "010101101100" 'Year 1434H HijriMonthSequence += "101010101101" 'Year 1435H HijriMonthSequence += "010101010101" 'Year 1436H HijriMonthSequence += "101100101001" 'Year 1437H HijriMonthSequence += "101110010010" 'Year 1438H HijriMonthSequence += "101110101001" 'Year 1439H HijriMonthSequence += "010111010100" 'Year 1440H HijriMonthSequence += "101011011010" 'Year 1441H HijriMonthSequence += "010101011010" 'Year 1442H HijriMonthSequence += "101010101011" 'Year 1443H HijriMonthSequence += "010110010101" 'Year 1444H HijriMonthSequence += "011101001001" 'Year 1445H HijriMonthSequence += "011101100100" 'Year 1446H HijriMonthSequence += "101110101010" 'Year 1447H HijriMonthSequence += "010110110101" 'Year 1448H HijriMonthSequence += "001010110110" 'Year 1449H HijriMonthSequence += "101001010110" 'Year 1450H Return HijriMonthSequence End Function #End Region ' Function DateFormating(ByVal _Date As String) As String #Region " DateFormating( _Date As String) As String " Public Function DateFormating(ByVal _Date As String) As String ' / تجزئة نص التاريخ من الفاصل Dim dt() As String = Split(_Date, "/") '------------------------------------------------------ ' في حالة عدم وجود فاصل تاريخ أصلا فيتم المغادرة If dt.Length <> 3 Then Return "" '------------------------------------------------------ ' التأكد أن أجزاء التاريخ هي أرقام فعلا For i = 0 To dt.Length - 1 If Not IsNumeric(dt(i)) Then Return "" End If Next i '------------------------------------------------------ ' ترتيب التاريخ بحيث يبدأ باليوم وينتهي السنة If Val(dt(0)) > 999 And Val(dt(2)) < 99 Then Dim a As String = Val(dt(0)) Dim b As String = Val(dt(2)) dt(0) = b : dt(2) = a End If '------------------------------------------------------ ' التأكد من عدم تجاوز كل جزء الحدود المسموح له If Val(dt(2)) < 1301 Or Val(dt(2)) > 2029 Then Return "" ' عدم تجاوز الشهر عن 12 If Val(dt(1)) < 1 _ Or Val(dt(1)) > 12 Then Return "" End If ' عدم تجاوز اليوم الهجري عن 30 If Val(dt(2)) >= 1301 _ And Val(dt(2)) <= 1450 Then If Val(dt(0)) < 1 Or Val(dt(0)) > 30 Then Return "" End If '------------------------------------------------------ Dim y As Integer, m As Integer, d As Integer d = Val(dt(0)).ToString("00") m = Val(dt(1)).ToString("00") y = Val(dt(2)).ToString("0000") Return Val(dt(0)).ToString("00") _ & "/" & Val(dt(1)).ToString("00") _ & "/" & Val(dt(2)).ToString("0000") End Function #End Region '#End Region #Region " ArabicWeekdayString " Private Function ArabicWeekdayString(ByVal weekdayValue As Integer) Dim w As String = String.Empty Select Case weekdayValue Case 7 w = "Saturday" Case 1 w = "Sunday" Case 2 w = "Monday" Case 3 w = "Tuesday" Case 4 w = "Wednesday" Case 5 w = "Thursday" Case 6 w = "Friday" End Select Return w End Function #End Region #Region " HiriMonthString " Private Function HiriMonthString(ByVal hijriMonthValue As Integer) Dim m As String = String.Empty Select Case hijriMonthValue Case 1 m = "Muharram" Case 2 m = "Safar" Case 3 m = "Rabi al-Awwal" Case 4 m = "Rabi ath-Thani" Case 5 m = "Jumada al-Ula" Case 6 m = "Jumada al-Akhirah" Case 7 m = "Rajab" Case 8 m = "Shaaban" Case 9 m = "Ramadan" Case 10 m = "Shawwal" Case 11 m = "Dhu al-Qaadah" Case 12 m = "Dhu al-Hijjah" End Select Return m End Function #End Region #Region " GregorianMonthString " Private Function GregorianMonthString(ByVal gregorianMonthValue As Integer) Dim m As String = String.Empty Select Case gregorianMonthValue Case 1 m = "January" Case 2 m = "February" Case 3 m = "March" Case 4 m = "April" Case 5 m = "May" Case 6 m = "June" Case 7 m = "July" Case 8 m = "August" Case 9 m = "September" Case 10 m = "October" Case 11 m = "November" Case 12 m = "December" End Select Return m End Function #End Region End Module ملاحظة: حقوق بعض الاكواد من google ارجو ان ينال موضوعي اعجابكم. حسنين Hijri_SEMO_Pa3x.rar
  6. السلام علكيم. الاغلب يعاني من مشكلة تصدير البيانات كان تكون جداول او استعلامات او تقارير..الخ الى اكسل ولكن! مع بقاء مسميات الحقول العربية ( Caption ) الان لنفرض لدي الجدول اسمة Customers وهذه الاعمدة الخاصة به واما المسميات فهي هذه الان عند محاول تصدير هذا الجدول الى اكسل بإستخدام VBA يتم تصديره ولكن لا تظهر المسميات العربية مثل اسم الموظف, الرقم الوظيفي..الخ بل تظهر اسماء الحقول باللغة الانكليزية , وهذه مشكلة. الان قم بأنشاء ماكرو جديد ثم طبق كما موجود بالصورة, اختر نوع الكائن الذي تريد تصديره جدول استعلام ... الخ واسم الكائن ، واهم شي تنتبه للتنسيق اختار كما قمت انا بأختياره وسيتم تصدير الجدول بالمسميات العربية. ارفقت لكم قاعدة بيانات كـ مثال للشرح لمن واجه صعوبة في شيئ ما. حسنين export_to_excel_semo_pa3x.accdb
  7. ارجو ان يكون الشرح واضح واذا استفدت ارجو ان لا تنساني من داعئك الصالح http://youtu.be/p2dsbTlK8m4
×
×
  • اضف...