a.kawkab

اعضاء المنتدى الكرام السلام عليكم تم والحمد لله حل المشكلتين (1) و(3)وتبقت المشكلة الثانية الخاصة بتثبيت رؤؤس الاعمدة فى الليست بوكس مرفق الملف بعد التعديل الخاصية Column Heads إلى True كانت مفعلة بالفغل وقد تم تدارك الخطا وهو ان رؤوس اغمدة البيانات كانت ضمن مدى rowsorce الليست بوكس لذلك كانت تتحرك مع البيانات وبعد ضبط مدىrowsorce الليست تم المطلوب وشكرا لكم A.k.2020_08-01-2020.xlsm

اساتذة المنتدى الكرام تحية طيبة للجميع فى الفورم المرفق مطلوب الاتى 1- يوجد كود فى حدث Duble clic فى الليست بوكس بحيث عند الضغط دبل كليك على الليست بوكس يجلب البيانات فى التكست بوكس من شيت(1)وليس من الليست بوكس ولكنه لا يعمل مطلوب تعديلة ليعمل 2- تثبيت رؤوس الاعمدة فى الليست بوكس بحيث لما احرك البيانات بها لاعلى واسفل يظل ثابت ولا يتخرك مع البيانات 3- مطلوب تعديل فورمات textbox7 لان القيمه 10% فى الشيت تظهر بها بهذا الشكل 0.10 وشكرا لكم A.k.2020_08-01-2020.xlsm

عمل رائع استاذ احمد بارك الله فيك ولكن وجدت ملاحطتين 1- عند التنقل بين الاوراق عن طريق الكومبوبوكس لاتتغير البيانات فى الليست بوكس 2-عند التنقل بين الاوراق والتكست بوكس غير فارغة يعطى خطأ لذلك قمت بهذا التعديل البسيط :- 1- فى حدث UserForm_Activate اضفت هذه الجزئية For i = 1 To 15 ""=Controls("textbox" & i).Text Next i ListBox1.Clear 2-فى حدث ComboBox1_Change وضعت هذه الجزئية UserForm_Activate وتلاشى الخطأ لا اعرف هل هذة الملحوطه ظهرت عندى فقط ام ظهرت عند احد اخر مرفق الملف بعد التعديل وشكرا لمجهوداتكم فورم بحث وإضافة وتعديل في كل أوراق العمل1.xlsm

اليك الملف بعد نسخ معادلة الاستاذ سليم حساب الاعداد المكررة مرة واحدة 1فقط.xlsx

الف مبروك على الانضمام الى الفريق بالتوفيق

شكرا استاذ ALI BABA تم التعديل واوفى بالمطلوب والحمد لله جزاك الله خيرا وزادك بسطة فى العلم

Public Sub CreateNewFile() Dim wb As Workbook Dim wbAS As Workbook Dim intX As Integer Dim strFileName As String Application.ScreenUpdating = False Application.DisplayAlerts = False Set wbAS = ActiveWorkbook ' The active workbook ' Open a new workbook to copy the new worksheets to it Set wb = Workbooks.Add ' Copy Sheets to the new workbook 'For intX = 1 To wbAS.Sheets.Count 'wbAS.Worksheets(intX).Copy after:=wb.Sheets(intX) 'Next intX ' or you can specify the sheets you want wbAS.Worksheets("åíÆÉ").Copy after:=wb.Sheets(1) wbAS.Worksheets("ØáÇÈ æÑÖÚ").Copy after:=wb.Sheets(1) ' Delete Sheet1 in the new workbook wb.Sheets(1).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True '##Prompt for SaveAs dialog box ' Name of new file strFileName = "Ahmed " & Format(Date, "DD MMM YY") ' Where to save the new file ' file_name = Application.GetSaveAsFilename(InitialFileName:=strFileName, FileFilter:="Excel 97-2003 Workbook (*.xlsx), *.xlsx") file_name = Application.GetSaveAsFilename(InitialFileName:=strFileName, FileFilter:="Excel macro-enabledwirkbook (*.xlsm), *.xlsm") ' See if the user canceled If file_name = False Then wb.Close SaveChanges:=False wbAS.Worksheets(1).Activate MsgBox "File was not created, actions cancelled." wb.Close Exit Sub Else wb.SaveAs Filename:=file_name, FileFormat:=xlOpenXMLWorkbook MsgBox "Your file has successfully been created.." End If End Sub شكرا استاذALI BABA على هذا الكود الجميل لكنة يحفظ الملف بصيغة xlsx حاولت تعديله الى صيغة xlsm اعطانى خطا فى السطر wb.SaveAs Filename:=file_name, FileFormat:=xlOpenXMLWorkbook فهل ممكن تتكرم وتعدل صيغة حفظ الملف الى xlsm

مطلوب كود حفظ عدد معين من الشيتات في ملف العمل بصيغة xlsm الملف المرفق به 7 شيتات المطلوب حفظ عدد معين من الشيتات وليكن شيت1وشيت2 وشيت4 وشيت7فى ملف منفصل بنفس اسماء الشيتات المطوب حفظها والملف يكون بنفس اسم الملف الاساسى بتاريخ يوم الحفظ مثلا Ahmed12/2019 orAhmed13/12/2019 Ahmed.xlsx

السلام عليكم اخى الكريم فوزى اولا : انت لم تحدد فى طلبك ان الطباعة لاكثر من شيت ثالثا : وهو الاهم اليك فورم طباعة لماتريد لعله يفى بطلبك Ahmed1.xlsm

السلام عليكم اليك ماتريد لعل الملف المرفق يفى بالغرض Ahmed.xlsm

بارك الله فيك استاذ مجدى وجزاك الله خير الثواب

ممكن شرح طريقة تغيير مسار الملف للاستفادة وشكرا

تم تعديل الاستعلام بالحلقات التكرارية شكرا للاستاذ العيدروس لتعديله للكود وتم تنشيط رقم المسلسل ويعمل بانتطام مرقق رابط مباشر للملف بعد التعديل الاخير 101استعلام عن طريق الاسم (4) .xlsm

فى خدث combobox3 dيوجد الكود التالى اكمل ال case لباقى الشيتات بنفس الطريقة وارجوا من اساتذة المنتدى الافاضل التكرم بتحويل هذا الكود الى حلقة تكرارية توفيرا للوقت والجهد ()Private Sub ComboBox3_Changet On Error Resume Next Dim ws As Worksheet Dim aa As String aa = ComboBox3.Value T = Cells(Rows.Count, 1).End(xlUp).Row TextBox1 = Val(Cells(T, 1)) + 1 ""=Me.ComboBox1.RowSource ""=Me.ComboBox2.RowSource ""=Me.ComboBox1.Text ""=Me.ComboBox2.Text For Each ws In ThisWorkbook.Worksheets If ws.Name = Me.ComboBox3.Value Then Sheets(aa).Select Select Case Me.ComboBox3 "Case "101 "Me.ComboBox1.RowSource = "name1 Me.ComboBox2.RowSource = "data1 "Case "102 "Me.ComboBox1.RowSource = "Name2 "Me.ComboBox2.RowSource = "data2 "Case "Sheet2 "Me.ComboBox1.RowSource = "sama "Me.ComboBox2.RowSource = "asd End Select End If Next End Sub

عفوا اخى الكريم الفورم موجود ويعمل بصورة جيدة اعدت تحميله لك مرة اخرى لاتفتحه بواسطة drive لان ذلك يؤدى لاختفاء الفورم حمله على الجهاز ثم فك الضغط ورب ضارة نافعة فقد عدلت لك كود الطباعة بالحلقات التكرارية ليعمل على جميع الصفحات بسهولة مرفق الرابط الجديد https://drive.google.com/file/d/1lejWvh6cW2-UaV0THDPOe_iHA_D0AYzj/view?usp=sharing 101استعلام عن طريق الاسم (3) .xlsm

السلام عليكم تم عمل فورم للطباعة وتم تطبيق العمل على الوراق من 101 : 106 عليك اكمال باقى الاوراق او الاستعانة باخد الاساتذة من الموقع لتحويل الكود الى صيغة تكرارية 101استعلام_عن_طريق_الاسم_(3)_.xlsm

هل تريد طباعة الفورم ام الشيتات؟

السلام عليكم تم التعديل ولكن بالنسبة للاستعلام فتم عمل 3 شيتات لضيق الوقت اكمل باقى الشيتات بنفس الطريقة 101استعلام عن طريق الاسم (3) .xlsm

السلام عليكم تم التعديل/ مرفق الملف 101استعلام عن طريق الاسم.xls

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

استاذنا الفاضل ا/ سليم شكرا لمجهودك واود الا ان اكون اثقلت على حضرتك لقد تم المطلوب بفضل مجهودكم ولكن طلب منى فى العمل ان يكون ترحيل البيانات مصحوبا بالمعادلات الموجودة فى شيت مجانى وليس ترحيل قيم فقط فهل اطمع فى كرم حضرتكم ان تعدل الكود بحيث يتم ترحيل البيانات من شيت مجانى الى شيت salim مصحوبا بالمعادلات وليس قيم فقط وشكرا لسعة صدركم

شكرا استاذنا الفاضل استاذ سليم وجزاك الله خيرا وزادك بسطة فى العلم لقد تعلمت منكم الكثير ولكنى احب ان افهم الاكواد قبل نقلها لذلك سؤالى بسيط ورد فى كودكم #Dim R#, i#, m R = Maj.Cells(Rows.Count, "Z").End(3).Row Sal.Range("A2", Range("A1").End(4)).ClearContents مامعنى # فى السطر الاول ومعتى( end(3 قى السطر الثانى وشكرا (هل تعنى( end(xl up ومعنى (end(4 فى السطر الثالث وشكرا لكم

شكرا استاذ سليم ولكن المطلوب ترحيل الا صناف الناتجة بالعمود z مع جميع بياناتها بباقى الاعمدة مثل شيت البيان فى المرفق My_book.xlsm

شكرا استاذنا الفاضل ا/ سليم ممكن طلب اخر لو تكرمت مطلوب كود او معادلة ايهما ايسر لفلترة الاصناف الناتجة من معادلةchoose فى العمود z ,وترحيلها الى صفحة جديدة

فى شيت مجانى مطلوب تعديل المعادلة بالعمود z بحيث تجلب اسم الصنف من العمودF بدلا من كتابة الحرف d ليكون الناتج مثل العمودAB جوجل ميل فرع سوهاج 10-2019.xlsx