هانى محمد

بارك الله فيك استاذنا الكريم ... بس فين هو البرنامج ؟!!

برنامج رائع استاذ منير بارك الله فيك

بارك الله فيك وجزاك الله كل خير مجهود وفير

تفضل الدخول الى عدة مواقع من الاكسيل1.xlsm

موضوع ممتاز بارك الله فى علمك استاذنا الكريم ونفع بك

تمام استاذى الكريم ,ربما هذا يتم من اعدادات الجهاز بأن اجعل التاريخ باللغة العربية -,وبالفعل عندما قمت بتعديل الإعدادات ظهر معى التاريخ تماما كما ظهر معك ولكن التاريخ غير دقيق فاليوم 6 رمضان وليس 7 رمضان ,,, هل يمكن تعديل هذا ولكن اليس هناك حل بأن يظهر بهذه الطريقة بدون تعديل وتغيير اعدادات التاريخ بالكمبيوتر ؟

عمل ممتاز استاذ منير أحسنت الى الأمام دائما

بارك الله فيك استاذ ابراهيم وزادك الله من فضله وهو ده المطلوب بالفعل بالنسبة لقيمة الليبل واشكرك كثيرا على كود الكمبوبوكس الأول حقا كود رائع وممتاز وأصغر من كودى وافضل منه بمراحل-جزاك الله كل خير وكل عام وانتم بخير هل يمكن استاذى الكريم بأن يظهر شكل وهيئة التاريخ التاريخ الهجرى فى الليبل 1 بالفورم مثل هذا الشكل .. لو ممكن حضرتك تقوم بتعديل هذا الكود ولكم جزيل الشكر وبارك الله فيكم Private Sub UserForm_activate() Calendar = vbCalHijri EDate = Date Label1.Caption = Format(Date, "d dddd mmm yyyy") End Sub Date.xlsb

السلام عليكم احبائى الكرام وكل عام وانتم جميعا بخير أرجو التعطف على مساعدتى فى ضبط هذه الجزئية من الكود لكى يظهر ناتج الليبل2 كما بالصورة بالتمام .. فهو يعمل معى تمام كما بالصورة ولكن بإختيار اسم المدينة أولاً ولكن عند اختيار اسم الدولة أولاً لا يظهر قيمة المدينة بعد اختيارها وهذا بالضبط هو الأدق من المفترض والطبيعى اختيار اسم الدولة اولا من الكمبوبوكس 1 ثم بعد ذلك اختيار اى مدينة أريدها لهذه الدولة بارك الله فيكم جميعا Label2.Caption = ComboBox2.Text & " - " & ComboBox1.Text Country.xlsb

والله لا يسمى هذا الا إبداع ... أحسنت استاذنا الكبير وهذا بالفعل هو المطلوب بارك الله فيك وزادك الله من فضله وأكرمك الله ووسع الله فى رزقك ورفعك الله اسمى الدرجات كود ممتاز جعله الله فى ميزان حسناتك , اشكرك كثيرا واتمنى من الله تفريج كرباتك كما دائما تفرج كربات العباد

السلام عليكم احبائى الكرام -ارجو التكرم على مساعدتى فى تعديل هذا الكود الذى يقوم بالترحيل من هذه الصفحة Main الى الصفحة الموجودة بالقائمة المنسدلة فى الخلية C1 على ان يتم بعد نهاية كل ترحيل اضافة مثل هذا السطر الأصفر الموجود به كلمة Total على ان يأخذ هذه القيمة من الخلية H3 الى الورقة المرحل اليها وللعلم هذا الكود من اعمال استاذنا الكبير سليم حاصبيا وسع الله فى رزقه وزاده الله من فضله Sub TransferToSpecificSheet2() Dim Cell As Range, t As String, LR As Long, LRT As Long Dim WS As Worksheet, Answer As Long, Bol As Boolean Set WS = Sheets("Main") LR = WS.Cells(1000, 3).End(xlUp).Row t = WS.Range("c1").Value Application.ScreenUpdating = False If Not IsEmpty(WS.Range("c1")) Then Bol = Evaluate("=ISREF(" & "'" & WS.Range("c1") & "'!A1)") If Not Bol Then Sheets.Add(, after:=Sheets(Sheets.Count)).Name = WS.Range("c1") WS.Range("A2:g" & LR).Copy With ActiveSheet .Range("a1").PasteSpecial (xlPasteValuesAndNumberFormats) .Range("a1").PasteSpecial (xlPasteColumnWidths) .Range("a1").PasteSpecial (xlPasteFormats) .DisplayRightToLeft = False End With WS.Select GoTo End_me End If WS.Range("A3:g" & LR).Copy With Sheets(t) LRT = .Cells(Rows.Count, 3).End(xlUp).Row + 1 With .Cells(LRT, 1) .PasteSpecial (xlPasteValuesAndNumberFormats) .PasteSpecial (xlPasteColumnWidths) .PasteSpecial (xlPasteFormats) End With End With Answer = MsgBox("Do you want to Clear the data on Sheet1 or not?", vbYesNo + vbQuestion) If Answer = vbYes Then Sheets("Main").Activate Sheets("Main").Range("b3:d1000,f3:f1000").Select Selection.ClearContents Else: End If Else End If End_me: Application.CutCopyMode = False Application.ScreenUpdating = True End Sub Supplier.xlsm

وعليكم السلام-ما تطلبه ليس بالسهل او الهين فالفورم خالى تماما من الأكواد فيصعب عمل اكواد فورم كاملة من البداية-والمنتدى كما تعلم تعليمى وليس لتقديم البرامج الجاهزة التى قد تستغرق المزيد من الوقت من الأساتذة الذى لا تعلم انت مدى ارتباطهم وانشغالهم يجب عليك استخدام خاصية البحث فى المنتدى وستجد طلبك ان شاء الله فيمكنك الإستعانة بهذا الرابط فورم بحث واظهار النتيجة فى الليست مع جمع البيانات فى TextBox

وعليكم السلام-طلباتك كثيرة ويصعب عمل كل هذا فالمنتدى تعليمى من المقام الأول وليس لعمل وتصميم البرامج الجاهزة ,فملفك حتى فارغ وخالى تماما من اية بيانات عليك التعلم من مشاهدة الفيديوهات التعليمية على اليوتيوب , فلا تجد احد يقوم هنا بتصميم وعمل كل هذا -فأنت لا تعرف اوقاتهم ومدى انشغال جميع الأساتذة فالكل يعمل هنا بدون مقابل ,فقط لوجه الله الكريم

بارك الله فيك استاذ محى بالفعل لدى هذه النسخة وقمت بتسطيبها سابقا-ولكن مازالت المشكلة قائمة

هل هناك حل لضبط هذا الكود اساتذتى الكرام ؟

بارك الله فيك استاذ محى -تم عمل هذه الخطوة بالفعل-ولكن ظهرت هذه الرسالة

السلام عليكم احبائى واساتذتى الأعزاء-ارجو التكرم فى مساعدتى فى ضبط وحل مشكلة هذا الكود وهو كود تحويل ملف Pdf بالكامل الى ملف إكسيل بارك الله فيكم جميعا Private Sub CommandButton1_Click() 'Declare Variable(s) Dim appAA As Acrobat.CAcroApp, docPDF As Acrobat.CAcroPDDoc Dim strFileName As String, intNOP As Integer, arrI As Variant Dim intC As Integer, intR As Integer, intBeg As Integer, intEnd As Integer 'Initialize Variables Set appAA = CreateObject("AcroExch.App"): Set docPDF = CreateObject("AcroExch.PDDoc") 'Set PDF FileName strFileName = ThisWorkbook.Path & "\" & "C:\Users\hany.ali\Desktop\PDF-to-Excel-Converter\EXcel.pdf" 'Read PDF File docPDF.Open (strFileName) 'Extract Number of Pages From PDF File intNOP = docPDF.GetNumPages 'Select First Data Cell Range("A1").Select 'Open PDF File ActiveWorkbook.FollowHyperlink strFileName, , True 'Loop Through All PDF File Pages For intC = 1 To intNOP 'Go To Page Number SendKeys ("+^n" & intC & "{ENTER}") 'Select All Data In The PDF File's Active Page SendKeys ("^a"), True 'Right-Click Mouse SendKeys ("+{F10}"), True 'Copy Data As Table SendKeys ("c"), True 'Minimize Adobe Window SendKeys ("%n"), True 'Paste Data In This Workbook's Worksheet ActiveSheet.Paste 'Select Next Paste Cell Range("A" & Range("A1").SpecialCells(xlLastCell).Row + 2).Select 'Maximize Adobe Window SendKeys ("%x") Next intC 'Close Adobe File and Window SendKeys ("^w"), True 'Empty Object Variables Set appAA = Nothing: Set docPDF = Nothing 'Select First Cell Range("A1").Select End Sub وهذا هو ملف Pdf http://www.mediafire.com/file/9cyzxvf5ch52imz/EXcel.rar/file Pdf.convert - 1.xlsm

ارفع ملف لو سمحت بنفسك يكون به المثال الذى تريده وسيتم الشرح من قبل الأساتذة ان شاء الله لا تنتظر ان يقوم احد بتصميم ملف لك فقط لو تريد هذه العلامة -- تعنى ان المطلوب العدد من نطاق معين وليس الإجمالى او المجموع

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

السلام عليكم اساتذتى الأعزاء -ارجو مساعدتى فى عمل معادلة لجلب رقم الشقة التى بها بيانات لكل صف وذلك كما بالنتيجة الموجودة بالملف فى العمود V Bulding.xlsm

الموضوع كما اخبرك الأستاذ أحمد ليس سهلا واعتقد انه ليس هناك حل طالما ان العمود الواحد يحتوى ويتضمن تواريخ هجرية وميلادية لا يمكن ان يتعامل مع التاريخ كأنه رقم

بوركت استاذ حسين كود رائع جعله الله فى ميزان حسناتك ورحم الله والديك وغفر الله لك ووسع الله فى رزقك

السلام عليكم احبائى واساتذتى الأعزاء,أتمنى ان تكونوا جميعا في أحسن حال أرجو التكرم من سيادتكم على مساعدتى في عمل اختصار لكود ترحيل البيانات من الفاتورة الى الصفحة الأخرى فالكود طويل جدا فياريت أجد عن حضراتكم حل لإختصار وتقصير هذا الكود بحيث يقوم بنفس المهام وهذا هو الكود : Private Sub FillSalesList() With Sheets("Sales").Columns(1).Rows(65536).End(xlUp) .Offset(1, 0) = Sheet1.[C1] .Offset(1, 1) = Sheet1.[C3] .Offset(1, 2) = Sheet1.[C5] .Offset(1, 3) = Sheet1.[C7] .Offset(1, 4) = Sheet1.[C9] .Offset(1, 5) = Sheet1.[A12] .Offset(1, 6) = Sheet1.[B12] .Offset(1, 7) = Sheet1.[C12] .Offset(1, 8) = Sheet1.[D12] .Offset(1, 9) = Sheet1.[E35] .Offset(1, 10) = Sheet1.[E36] .Offset(1, 11) = Sheet1.[E37] .Offset(1, 12) = Sheet1.[E38] If Sheet1.[a13].Value <> "" Then .Offset(2, 0) = Sheet1.[C1] .Offset(2, 1) = Sheet1.[C3] .Offset(2, 2) = Sheet1.[C5] .Offset(2, 3) = Sheet1.[C7] .Offset(2, 4) = Sheet1.[C9] .Offset(2, 5) = Sheet1.[a13] .Offset(2, 6) = Sheet1.[B13] .Offset(2, 7) = Sheet1.[C13] .Offset(2, 8) = Sheet1.[D13] End If If Sheet1.[a14].Value <> "" Then .Offset(3, 0) = Sheet1.[C1] .Offset(3, 1) = Sheet1.[C3] .Offset(3, 2) = Sheet1.[C5] .Offset(3, 3) = Sheet1.[C7] .Offset(3, 4) = Sheet1.[C9] .Offset(3, 5) = Sheet1.[a14] .Offset(3, 6) = Sheet1.[B14] .Offset(3, 7) = Sheet1.[C14] .Offset(3, 8) = Sheet1.[D14] End If If Sheet1.[a15].Value <> "" Then .Offset(4, 0) = Sheet1.[C1] .Offset(4, 1) = Sheet1.[C3] .Offset(4, 2) = Sheet1.[C5] .Offset(4, 3) = Sheet1.[C7] .Offset(4, 4) = Sheet1.[C9] .Offset(4, 5) = Sheet1.[a15] .Offset(4, 6) = Sheet1.[B15] .Offset(4, 7) = Sheet1.[C15] .Offset(4, 8) = Sheet1.[D15] End If If Sheet1.[a16].Value <> "" Then .Offset(5, 0) = Sheet1.[C1] .Offset(5, 1) = Sheet1.[C3] .Offset(5, 2) = Sheet1.[C5] .Offset(5, 3) = Sheet1.[C7] .Offset(5, 4) = Sheet1.[C9] .Offset(5, 5) = Sheet1.[a16] .Offset(5, 6) = Sheet1.[B16] .Offset(5, 7) = Sheet1.[C16] .Offset(5, 8) = Sheet1.[D16] End If If Sheet1.[a17].Value <> "" Then .Offset(6, 0) = Sheet1.[C1] .Offset(6, 1) = Sheet1.[C3] .Offset(6, 2) = Sheet1.[C5] .Offset(6, 3) = Sheet1.[C7] .Offset(6, 4) = Sheet1.[C9] .Offset(6, 5) = Sheet1.[a17] .Offset(6, 6) = Sheet1.[B17] .Offset(6, 7) = Sheet1.[C17] .Offset(6, 8) = Sheet1.[D17] End If If Sheet1.[a18].Value <> "" Then .Offset(7, 0) = Sheet1.[C1] .Offset(7, 1) = Sheet1.[C3] .Offset(7, 2) = Sheet1.[C5] .Offset(7, 3) = Sheet1.[C7] .Offset(7, 4) = Sheet1.[C9] .Offset(7, 5) = Sheet1.[a18] .Offset(7, 6) = Sheet1.[B18] .Offset(7, 7) = Sheet1.[C18] .Offset(7, 8) = Sheet1.[D18] End If If Sheet1.[a19].Value <> "" Then .Offset(8, 0) = Sheet1.[C1] .Offset(8, 1) = Sheet1.[C3] .Offset(8, 2) = Sheet1.[C5] .Offset(8, 3) = Sheet1.[C7] .Offset(8, 4) = Sheet1.[C9] .Offset(8, 5) = Sheet1.[a19] .Offset(8, 6) = Sheet1.[B19] .Offset(8, 7) = Sheet1.[C19] .Offset(8, 8) = Sheet1.[D19] End If If Sheet1.[a20].Value <> "" Then .Offset(9, 0) = Sheet1.[C1] .Offset(9, 1) = Sheet1.[C3] .Offset(9, 2) = Sheet1.[C5] .Offset(9, 3) = Sheet1.[C7] .Offset(9, 4) = Sheet1.[C9] .Offset(9, 5) = Sheet1.[a20] .Offset(9, 6) = Sheet1.[B20] .Offset(9, 7) = Sheet1.[C20] .Offset(9, 8) = Sheet1.[D20] End If If Sheet1.[a21].Value <> "" Then .Offset(10, 0) = Sheet1.[C1] .Offset(10, 1) = Sheet1.[C3] .Offset(10, 2) = Sheet1.[C5] .Offset(10, 3) = Sheet1.[C7] .Offset(10, 4) = Sheet1.[C9] .Offset(10, 5) = Sheet1.[a21] .Offset(10, 6) = Sheet1.[B21] .Offset(10, 7) = Sheet1.[C21] .Offset(10, 8) = Sheet1.[D21] End If If Sheet1.[a22].Value <> "" Then .Offset(11, 0) = Sheet1.[C1] .Offset(11, 1) = Sheet1.[C3] .Offset(11, 2) = Sheet1.[C5] .Offset(11, 3) = Sheet1.[C7] .Offset(11, 4) = Sheet1.[C9] .Offset(11, 5) = Sheet1.[a22] .Offset(11, 6) = Sheet1.[B22] .Offset(11, 7) = Sheet1.[C22] .Offset(11, 8) = Sheet1.[D22] End If If Sheet1.[a23].Value <> "" Then .Offset(12, 0) = Sheet1.[C1] .Offset(12, 1) = Sheet1.[C3] .Offset(12, 2) = Sheet1.[C5] .Offset(12, 3) = Sheet1.[C7] .Offset(12, 4) = Sheet1.[C9] .Offset(12, 5) = Sheet1.[a23] .Offset(12, 6) = Sheet1.[B23] .Offset(12, 7) = Sheet1.[C23] .Offset(12, 8) = Sheet1.[D23] End If If Sheet1.[a24].Value <> "" Then .Offset(13, 0) = Sheet1.[C1] .Offset(13, 1) = Sheet1.[C3] .Offset(13, 2) = Sheet1.[C5] .Offset(13, 3) = Sheet1.[C7] .Offset(13, 4) = Sheet1.[C9] .Offset(13, 5) = Sheet1.[a24] .Offset(13, 6) = Sheet1.[B24] .Offset(13, 7) = Sheet1.[C24] .Offset(13, 8) = Sheet1.[D24] End If If Sheet1.[a25].Value <> "" Then .Offset(14, 0) = Sheet1.[C1] .Offset(14, 1) = Sheet1.[C3] .Offset(14, 2) = Sheet1.[C5] .Offset(14, 3) = Sheet1.[C7] .Offset(14, 4) = Sheet1.[C9] .Offset(14, 5) = Sheet1.[a25] .Offset(14, 6) = Sheet1.[B25] .Offset(14, 7) = Sheet1.[C25] .Offset(14, 8) = Sheet1.[D25] End If If Sheet1.[a26].Value <> "" Then .Offset(15, 0) = Sheet1.[C1] .Offset(15, 1) = Sheet1.[C3] .Offset(15, 2) = Sheet1.[C5] .Offset(15, 3) = Sheet1.[C7] .Offset(15, 4) = Sheet1.[C9] .Offset(15, 5) = Sheet1.[a26] .Offset(15, 6) = Sheet1.[B26] .Offset(15, 7) = Sheet1.[C26] .Offset(15, 8) = Sheet1.[D26] End If If Sheet1.[a27].Value <> "" Then .Offset(16, 0) = Sheet1.[C1] .Offset(16, 1) = Sheet1.[C3] .Offset(16, 2) = Sheet1.[C5] .Offset(16, 3) = Sheet1.[C7] .Offset(16, 4) = Sheet1.[C9] .Offset(16, 5) = Sheet1.[a27] .Offset(16, 6) = Sheet1.[B27] .Offset(16, 7) = Sheet1.[C27] .Offset(16, 8) = Sheet1.[D27] End If If Sheet1.[a28].Value <> "" Then .Offset(17, 0) = Sheet1.[C1] .Offset(17, 1) = Sheet1.[C3] .Offset(17, 2) = Sheet1.[C5] .Offset(17, 3) = Sheet1.[C7] .Offset(17, 4) = Sheet1.[C9] .Offset(17, 5) = Sheet1.[a28] .Offset(17, 6) = Sheet1.[B28] .Offset(17, 7) = Sheet1.[C28] .Offset(17, 8) = Sheet1.[D28] End If If Sheet1.[a29].Value <> "" Then .Offset(18, 0) = Sheet1.[C1] .Offset(18, 1) = Sheet1.[C3] .Offset(18, 2) = Sheet1.[C5] .Offset(18, 3) = Sheet1.[C7] .Offset(18, 4) = Sheet1.[C9] .Offset(18, 5) = Sheet1.[a29] .Offset(18, 6) = Sheet1.[B29] .Offset(18, 7) = Sheet1.[C29] .Offset(18, 8) = Sheet1.[D29] End If If Sheet1.[a30].Value <> "" Then .Offset(19, 0) = Sheet1.[C1] .Offset(19, 1) = Sheet1.[C3] .Offset(19, 2) = Sheet1.[C5] .Offset(19, 3) = Sheet1.[C7] .Offset(19, 4) = Sheet1.[C9] .Offset(19, 5) = Sheet1.[a30] .Offset(19, 6) = Sheet1.[B30] .Offset(19, 7) = Sheet1.[C30] .Offset(19, 8) = Sheet1.[D30] End If If Sheet1.[a31].Value <> "" Then .Offset(20, 0) = Sheet1.[C1] .Offset(20, 1) = Sheet1.[C3] .Offset(20, 2) = Sheet1.[C5] .Offset(20, 3) = Sheet1.[C7] .Offset(20, 4) = Sheet1.[C9] .Offset(20, 5) = Sheet1.[a31] .Offset(20, 6) = Sheet1.[B31] .Offset(20, 7) = Sheet1.[C31] .Offset(20, 8) = Sheet1.[D31] End If If Sheet1.[a32].Value <> "" Then .Offset(21, 0) = Sheet1.[C1] .Offset(21, 1) = Sheet1.[C3] .Offset(21, 2) = Sheet1.[C5] .Offset(21, 3) = Sheet1.[C7] .Offset(21, 4) = Sheet1.[C9] .Offset(21, 5) = Sheet1.[a32] .Offset(21, 6) = Sheet1.[B32] .Offset(21, 7) = Sheet1.[C32] .Offset(21, 8) = Sheet1.[D32] End If ' .Offset(1, 6) = Sheet1.[G1].Text End With End Sub وهذا هو الملف كود ترحيل الفاتورة.xlsm

أعرف مقصدك استاذ عبدالله وانا لم اجد هذه المكتبة عندى فى هذه القوائم وشاكر جدا لحضرتك على هذه الموضوعات القيمة ولكن هذا ليس مقصدى فالكود المرسل فى ملفى يفترض ان يرسل اميلات مباشرة لأصحاب واسماء الإميلات الموجودة بالملف عند حلول اعياد ميلادهم للتهنئة بعيد الميلاد حتى لا انسى تهنئتهم جزاك الله كل خير واسف جدا على تعب وازعاج حضرتك-واتمنى لو حضرتك تتمكن من مساعدتى فى هذا الأمر ولكم جزيل الشكر

بارك الله فيك استاذى الكريم ولكن ليست لدى هذه المكتبة , فكيف يمكننى الحصول عليها ؟