خزاني

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

عمل رائع وجميل

مبروك علي الترقية

السلام عليكم ورحمة الله وبركاته ("Me.TextBox1.Text = Format(Me.TextBox1.Text, "dd/mm/yyyy

يجب ان يكون كود الورقة مطابق الكود داخل vb Range("c2").Value = Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("c:").SerialNumber) الكود داخل vb If Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("C:").SerialNumber) <> "6A73DE0A" Then MsgBox "Attention ! Ce programme est spécial pour M : Ben amar khezzani ", vbCritical, "Violation des droits du programme" ThisWorkbook.Close SaveChanges = True End If

قم بتغير الكود داخل ورقة الاكسل فقط وسوف يقوم بقراءة الكود شاهد الصورة المرفقة Range("c2").Value = Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("c:").SerialNumber)

فورم إدجال بيانات الموظفين مع صورة للموظف 8888.rar

تصميم ملف الباور بوينت وفتحه عن طريق الاكسل khezzani.rar

عمل رائع تقبل وافر احترامى لشخصك الكريم

السلام عليكم ورحمة الله وبركاته الحماية vba 3AF4

أهلا بك ياأخي الكريم وسهلا في منتداك وبين اخوانك

موضوع رائع و مشكور وجزاك الله الف خير

Classeur2 (4).rar

السلام عليكم تغـيـيـر ديـنار بــــــــــــــــــــــ: ريـال وضع هذا فى الخلبة (NbLettresArabes(H6= ' --------------------------------------------- ' FONCTION DE TRADUCTION D'UNE SOMME EN LETTRES ' --------------------------------------------- Option Explicit Option Base 1 Public Unité As Variant Public Dizaine As Variant Public Décimales As Currency Public CasPart As Variant Public Lettres As String Public Cent_Pluriel As Boolean ' ------------------- ' FONCTION PRINCIPALE ' ------------------- ' Function NbLettresArabes(Nombre As Currency) As String ' Limitation à 999 999 999 999 . 99 If Nombre >= 1000000000000# Then MsgBox "! هاذ العدد كبير", 0, "Message" Exit Function End If ' Initialisation des tableaux Unité = Array("واحد", "اثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية ", "تسعة") Dizaine = Array("عشرة", "عشرون", "ثلاثون", "اربعون", "خمسون", "ستون", "سبعون", "ثمانون", "تسعون") CasPart = Array("عشرة", "احد عشرة", "اثن عشرة", "ثلاثة عشرة", "أربعة عشرة", "خمسةعشرة", "ستةعشرة", "سبعةعشرة", "ثمانية عشرة", "تسعة عشرة") ' Mise à vide de la chaîne de réception de la traduction du nombre Lettres = "" ' Initialisation des indicateurs de pluriel des nombres cent et vingt Cent_Pluriel = True ' Conversion de la partie décimale en un nombre de 0 à 99 ' arrondi à l'unité la plus proche Décimales = CInt((Nombre - Fix(Nombre)) * 100) ' Conservation de la partie entière du nombre Nombre = Fix(Nombre) ' Orientation du traitement suivant valeur de la partie entière Select Case Nombre Case 0 Lettres = "صفر" 'Zéro Case 1 To 9 Lettres = Unité(CInt(Nombre)) Case 10 To 99 Trt_Dizaines Nombre Case 100 To 999 Trt_Centaines Nombre Case 1000 To 999999999999# Trt_Multiples_de_Mille Nombre End Select ' Indication de la monnaie If Décimales > 0 Then Lettres = Lettres & " دينار " + " و " Else If Décimales = 0 Then Lettres = Lettres & " دينار " ' + " و " End If End If ' Orientation du traitement suivant valeur de la partie décimale Select Case Décimales Case 1 To 9 Lettres = Lettres & Unité(CInt(Décimales)) Case 10 To 99 Trt_Dizaines Décimales End Select ' Indication des centimes Select Case Décimales Case 1 Lettres = Lettres & " سنتيم" ' Centimes'" و" + Case Is > 1 Lettres = Lettres & " سنتيم" ' Centimes Case Is < 1 Lettres = Lettres ' & " سنتيم" ' Centimes End Select ' Renvoi du nombre traduit en lettres If Lettres = "صفر" & " دينار " Then Lettres = "" Else NbLettresArabes = Lettres End If End Function ' -------------------------------- ' TRAITEMENT DES MULTIPLES DE 1000 ' -------------------------------- Sub Trt_Multiples_de_Mille(Nombre As Currency) Dim Rank As Currency Dim Nom_Rang As String Dim Reste As Currency Cent_Pluriel = False ' Initialisation suivant taille du nombre : milliers, millions ou milliards Select Case Nombre Case 1000 To 999999 Rank = Fix(Nombre / 1000) Reste = Nombre Mod 1000 Nom_Rang = "ألف" ' Mille Case 1000000 To 999999999 Rank = Fix(Nombre / 1000000) Reste = Nombre Mod 1000000 If Rank > 1 Then Nom_Rang = "مليون" 'Millions Else Nom_Rang = "مليون" ' Million End If Case Is > 999999999 Rank = Fix(Nombre / 1000000000) Reste = Nombre - Rank * 1000000000 If Rank > 1 Then Nom_Rang = "ميليار" ' Milliard Else Nom_Rang = "ميليار" ' Milliard End If End Select ' Traitement du rang des milliers, millions ou milliards Select Case Rank Case 1 If Nom_Rang = "الف" Then Lettres = Lettres & "آلاف" Else Lettres = Lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " و" End If Case 2 Lettres = Lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " و" Case 3 To 9 Lettres = Lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " و" Case 10 To 99 Trt_Dizaines (Rank) Lettres = Lettres & " " & Nom_Rang '& " و" Case 100 To 999 Trt_Centaines Rank Lettres = Lettres & " " & Nom_Rang '& " و" End Select Cent_Pluriel = True ' Orientation du traitement du reste si > 0 Select Case Reste Case 1 To 9 Lettres = Lettres & " و" & " " & Unité(CInt(Reste)) Case 10 To 99 Lettres = Lettres & " و" & " " Trt_Dizaines Reste Case 100 To 999 Lettres = Lettres & " و" & " " Trt_Centaines Reste Case Is > 999 Lettres = Lettres & " و" & " " Trt_Multiples_de_Mille Reste Case Else Lettres = Lettres & " " End Select Lettres = Lettres End Sub ' ----------------------------------- ' TRAITEMENT DES NOMBRES DE 100 0 999 ' ----------------------------------- Sub Trt_Centaines(Nombre As Currency) Dim Rank As Currency Dim Reste As Currency Rank = Fix(Nombre / 100) Reste = Nombre Mod 100 ' Traitement du rang des centaines If Rank = 1 Then If Reste = 0 Then Lettres = Lettres & "مائة" '& " و" Else Lettres = Lettres & "مائة" & " و" End If Else If Reste = 0 And Cent_Pluriel Then Lettres = Lettres & Unité(CInt(Rank)) & " " & "مئات" Else Lettres = Lettres & Unité(CInt(Rank)) & " " & "مئات" & " و" End If End If ' Traitement du reste < 100 Select Case Reste Case 1 To 9 Lettres = Lettres & " " & Unité(CInt(Reste)) Case Is > 9 Lettres = Lettres & " " Trt_Dizaines (Reste) End Select End Sub ' --------------------------------- ' TRAITEMENT DES NOMBRES DE 10 0 99 ' --------------------------------- Sub Trt_Dizaines(Nombre As Currency) Dim Reste As Integer Dim Rank As Integer Rank = Fix(Nombre / 10) Reste = Nombre Mod 10 Select Case Rank Case 1 Lettres = Lettres & CasPart(Reste + 1) Case 7 Select Case Reste Case 0 ' Nombre 70 Lettres = Lettres & Dizaine(Rank) Case Else ' Nombre 71 à 76 Lettres = Lettres & Unité(CInt(Reste)) & " و " & Dizaine(Rank) End Select Case 8 If Reste = 0 Then ' Nombre 80 Lettres = Lettres & Dizaine(Rank) Else ' Nombres 81 à 89 Lettres = Lettres & Unité(CInt(Reste)) & " و " & Dizaine(Rank) End If Case 9 If Reste = 0 Then ' Nombres 90 Lettres = Lettres & Dizaine(Rank) Else ' Nombres 91 à 99 Lettres = Lettres & Unité(CInt(Reste)) & " و " & Dizaine(Rank) End If Case Else ' Nombres 20 à 69 Select Case Reste Case 0 ' Nombres 20, 30, 40, 50, 60 Lettres = Lettres & Dizaine(Rank) Case Else ' Autres nombres Lettres = Lettres & Unité(CInt(Reste)) & " و " & Dizaine(Rank) End Select End Select End Sub

السلام عليكم ثقل الصفحة التفكير في الواقع حول استخدام VBA إلى الصيغة الخاصة بك التي تمنع حجم ملف أكبر ونسخ ولصق البيانات إلى قيمة فقط وهذا هو ما فعلته وبالتالى هناك 3 أشياء بالفعل: 1) ذاكرة الكمبيوتر 2) الملفات الوزن 3) SUMPRODUCT هو الموارد مكثفة جدا واحسن شى هو استخدام VBA ----------------------------------------------------------------------------------------------------------------- هذه الأداة المساعدة - مشاريع VBA المدمجة وdecompiled المحفوظة في أي والوصول، إكسل، باور بوينت، وورد نوع الملف، بما في ذلك الوظائف الإضافية - فك وكلمة المرور المدمجة المحمية مشاريع VBA دون نبروتيكتينغ م - فك والمدمجة (ينظف) رمز VBA في وحدات وحدات قياسية في أي وحدة من الدرجة راء الأشياء بما في ذلك نموذج، ورقة عمل، المصنف، الشرائح، وثيقة - وdecompiled ويتم حفظ الملف المضغوط في حجم إصدار التطبيق الافتراضية المثبتة على الكمبيوتر. ولكن، إذا كان هناك أكثر من إصدار تثبيت الإصدار محددة يمكن اختيار - اختياريا يمكن الحفاظ على تاريخ ووقت الملف الأصلي - بإنشاء نسخة احتياطية من الملف الأصلي. يمكنك اختياريا إنشاء ملف النسخ الاحتياطي واحد في كل مرة يتم تشغيل الأداة المساعدة أو سلسلة من النسخ الاحتياطية بالتسلسل مرقمة - يمكن تسجيل النشاط اختياريا في ملف سجل - لا يتطلب تثبيت - هذه الأداة تتكون من ملف مستقل قابل للتنفيذ الذي يستخدم Office تثبيت المكتبة. ليس هناك حاجة لمكتبات أو التكوينات الأخرى - الأداة لا تعديل تكوين أي تطبيق آخر. أنها لا تحتل الوصول، إكسل، باور بوينت أو Word الوظائف الإضافية مثل الذكريات وCOM الوظائف الإضافية تفعل - تلقائيا بحفظ الإعداد الأخير لاستخدامها في تنفيذ الافتراضي المقبل. يتم حفظ جميع الخيارات، بما في ذلك مسار المجلد في ملف INI بجانب VBADecompiler.exe الذهب، وعندما لم يكن ذلك ممكنا، في المجلد Temp ® مايكروسوفت ® ويندوز. - يمكن تشغيل عملية بتفريغ وضغط من المستخدم الرسومية أو بصمت من واجهة سطر الأوامر. سطر الأوامر يدعم جميع الخيارات من نفس واجهة المستخدم الرسومية - يمكنك إنشاء أسطر الأوامر كاملة من واجهة المستخدم وإرسال 'م إلى الحافظة للصق في أي مكان،: في مثل حجة وظيفة VB أو VBA شل أو في مربع الحوار تشغيل ويندوز. حمل من هنا http://cpap.com.br/orlando/download2/VBADecompiler.zip عرض حجم ملف في شريط الحالة Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Application.DisplayStatusBar = True Application.StatusBar = FileLen(ActiveWorkbook.FullName) / 1024 & " Ko." End Sub Private Sub Workbook_Deactivate() Application.StatusBar = "" End Sub Sub Taille() Application.StatusBar = "Taille initiale de ce classeur en octets = " & FileLen(ActiveWorkbook.FullName) End Sub Application.CommandBars("Worksheet Menu Bar"). _ Controls("Fichier").Controls("Enregistrer").OnAction = "Taille" Fichier = ActiveWorkbook.FullName ActiveWorkbook.SaveAs Filename:= Fichier, FileFormat _ :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _ False, CreateBackup:=False

شكرا لك على الموضوع الجميل و المفيد جزاك الله الف خير على كل ما تقدمه لهذا المنتدى ننتظر ابداعاتك الجميلة بفارغ الصبر

مجهود رائع دائماً فى تقدم انشاء الله جزاكم الله كل خيراً

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

محمود الشريف أبو إيمان

ممكن نسخ احتياطي كل شهرالى مسار معين داخل اجهزة حاسوب بستخدام مفتاح F12 وتعدل اسم ملف الحفظ

لا تستطبع أرجع العمل مثل ما كان قبل

حمل برنامجْ FlippingBook Publisher

عمل رائع جعله الله فى ميزان حسناتك

سلمت يداك اخى