عبده الطوخى 1970

السلام عليكم ورحمه الله وبركاته لدى ComboBox1 يتم اختيار الصفحة منه ثم البحث من خلال كتابة التاريخ فى TextBox2 ثم الضغط على زر امر CommandSearchDate يتم عرض العناصر المطلوبة فى ListBox1 و ListBox2 المطلوب كود يعمل على حذف الصفوف المحددة فى ListBox1 وحذفها من الصفحة المحددة الموجودة ComboBox1 مع التحديد باى لون حتى ارى الصفوف المراد حذفها وتم عمل كود ولكن لا يعمل بالكشل المطلوبة (( مرفق الكود )) Private Sub CommandButtonDelete_Click() Dim sheetName As String Dim ws As Worksheet Dim i As Long Dim selectedRow As Long Dim selectedItems As Collection Dim response As VbMsgBoxResult ' ÊÍÞÞ ãä Ãä åäÇß ÚäÕÑðÇ ãÍÏÏðÇ Ýí ListBox1 If ListBox1.ListIndex = -1 Then MsgBox "ãä ÝÖáß ÍÏÏ ÇáÕÝæÝ ÇáÊí ÊÑíÏ ÍÐÝåÇ ãä ÇáÞÇÆãÉ.", vbExclamation Exit Sub End If ' ÇáÊÃßÏ ãä ÑÛÈÉ ÇáãÓÊÎÏã Ýí ÇáÍÐÝ response = MsgBox("åá ÃäÊ ãÊÃßÏ ãä ÍÐÝ ÇáÕÝæÝ ÇáãÍÏÏÉ ãä ÇáæÑÞÉ¿", vbYesNo + vbExclamation, "ÊÃßíÏ ÇáÍÐÝ") If response = vbNo Then Exit Sub ' ÇáÍÕæá Úáì ÇÓã ÇáæÑÞÉ ÇáãÍÏÏÉ sheetName = ComboBox1.Value ' ÇáÊÍÞÞ ãä æÌæÏ ÇáæÑÞÉ ÇáãÍÏÏÉ On Error Resume Next Set ws = ThisWorkbook.Sheets(sheetName) On Error GoTo 0 If ws Is Nothing Then MsgBox "ÇáæÑÞÉ ÇáãÍÏÏÉ ÛíÑ ãæÌæÏÉ!", vbExclamation Exit Sub End If ' ÅÚÏÇÏ ÇáÜ Collection áÍÝÙ ÇáÕÝæÝ ÇáãÍÏÏÉ Set selectedItems = New Collection For i = 0 To ListBox1.ListCount - 1 ' ÇáÊÍÞÞ ãä Ãä ÇáÚäÕÑ ÇáãÍÏÏ Ýí ListBox1 åæ ÑÞã ÕÍíÍ If ListBox1.Selected(i) Then If IsNumeric(ListBox1.List(i, 0)) Then ' ÅÐÇ ßÇä ÇáÑÞã ÕÇáÍðÇ¡ ÃÖÝå Åáì ÇáÜ Collection selectedRow = CLng(ListBox1.List(i, 0)) ' ÅÖÇÝÉ ÑÞã ÇáÕÝ ÇáãÍÏÏ selectedItems.Add selectedRow ' ÅÖÇÝÉ ÇáÕÝ Åáì ÇáÜ Collection ElseIf IsDate(ListBox1.List(i, 0)) Then ' ÅÐÇ ßÇäÊ ÇáÞíãÉ ÊÇÑíÎðÇ¡ ÍæáåÇ Åáì ÇáÑÞã ÇáãÞÇÈá áåÇ Ýí ÇáæÑÞÉ MsgBox "Êã ÊÍÏíÏ ÊÇÑíÎ: " & ListBox1.List(i, 0), vbInformation ' åäÇ íãßä æÖÚ ãäØÞ ÂÎÑ ÅÐÇ ßäÊ ÈÍÇÌÉ ááÊÚÇãá ãÚ ÇáÊæÇÑíÎ ÈÔßá ÎÇÕ Else MsgBox "ÇáÕÝ ÇáãÍÏÏ áíÓ ÑÞãðÇ ÕÇáÍðÇ Ãæ ÊÇÑíÎðÇ: " & ListBox1.List(i, 0), vbCritical Exit Sub End If End If Next i ' ÇáÊÍÞÞ ãä Ãäå Êã ÊÍÏíÏ ÕÝæÝ ááÍÐÝ If selectedItems.Count = 0 Then MsgBox "áã ÊÞã ÈÊÍÏíÏ Ãí ÕÝæÝ áÍÐÝåÇ.", vbExclamation Exit Sub End If ' ÅíÞÇÝ ÊÍÏíË ÇáÔÇÔÉ áÊÓÑíÚ ÇáÚãáíÉ Application.ScreenUpdating = False ' ÍÐÝ ÇáÕÝæÝ ÇáãÍÏÏÉ ÈÏÁðÇ ãä ÇáÕÝ ÇáÃÎíÑ áÖãÇä ÚÏã ÊÛííÑ ÊÑÊíÈ ÇáÕÝæÝ For i = selectedItems.Count To 1 Step -1 selectedRow = selectedItems(i) ws.Rows(selectedRow + 1).Interior.Color = RGB(255, 255, 0) ' ÊãííÒ ÇáÕÝ ÈÇááæä ÇáÃÕÝÑ ws.Rows(selectedRow + 1).Delete ' ÍÐÝ ÇáÕÝ Next i Application.ScreenUpdating = True ' ÅÚÇÏÉ ÊÝÚíá ÊÍÏíË ÇáÔÇÔÉ ' ÅÒÇáÉ ÇáÚäÇÕÑ ÇáãÍÐæÝÉ ãä ListBox1 For i = ListBox1.ListCount - 1 To 0 Step -1 If ListBox1.Selected(i) Then ListBox1.RemoveItem i End If Next i ' ÚÑÖ ÑÓÇáÉ ÊÃßíÏ ÈÚÏ ÚãáíÉ ÇáÍÐÝ MsgBox "Êã ÍÐÝ ÇáÕÝæÝ ÇáãÍÏÏÉ ÈäÌÇÍ.", vbInformation End Sub نموذج الكهرباء _ اكسيل.xlsm

شكرا لكم لعدم الاهتمام

السادة الافاضل تحية طيبة وبعد ،،، ربما اكون غير موضح للفكرة بشكل جيد عندنا فى الشركة يوجد فواتير كهرباء لكل منشاة داخلية ( عداد رئيسى + عداد فرعى ) يتم تجميع استهلاك العدادات الفرعية ويخصم اجمالى الاستهلاك من العداد الرئيسى لذلك تم عمل listbox1 خاصة بالعداد الرئيسى تم عمل listbox2 خاصة بالعداد الفرعى تم عمل نعديلات بالملف ولكن امكانياتى ضعيفة وقد استعنت ببعض المشاريع الموجودة لديكم وكذلك الفيديوهات وكذلك chatgpt لاذا ارجو التكرم بالمساعدة سواء بالملف القديم او بالملف الجديد ولكم جزيل الشكر والاحترام نموذج الكهرباء 1.rar

برجاء الرد اعانكم الله

السادة الافضل تحية طيبة وبعد ،،، انا اعمل على مشروع فواتير الكهرباء ومحتاج خبراتكم فى تصحيح الاكواد الموجودة به 1 - الــ userform1 به TextBox1 لعمل بحث او فلترة برقم الجهة من listbox1 + listbox2 2- textbox2 لعمل بحث او فلترة تاريخ الاصدار من listbox1 + listbox2 3 - ادراج رؤو الاعمدة فى listbox1 + listbox2 نتمنى منكم التوفيق ان شاء الله نموذج الكهرباء _ اكسيل.xlsm

الف شكر لحضرتك استاذ Foksh الكود يعمل بشكل ممتاز جدا [Forms]![Frm_Data_entry]![Frm_Fatura_Main].[Form]![Net_Teams] = [Forms]![Frm_Data_entry]![Frm_Fatura_Main].[Form]![Total_Main_Meter] - [Forms]![Frm_Data_entry]![Frm_Fatura_Sub].[Form]![Total_Sub_Meter] هل اطمع منك فى المزيد هل يوجد تصميم افضل للبرنامج من التصميم الحالى حيث اننى توفقت منذ فترة طويلة جدا حوالى 10 سنوات فى العمل على الاكسيس واكيد هناك تحديثات افضل بكثير تمت فى الفترة الاخيرة لكم منى جزيل الشكر والاحترام

السلام عليكم ورحمه الله وبركاته عندى قاعدة بيانات اكسيس خاصة بفاتورة الكهرباء بعد التصميم والتنفيذ واجهتنى بعض المشاكل 1- يوجد حقل باسم Net_Teams ( صافى الاستهلاك ) = Total_Main_Meter فى النموذج Total_Sub_Meter - Frm_Fatura_Main فى النموذج Frm_Fatura_Sub مطلوب حساب الحقل بكود برمجى فى النموذج وعند الحفظ او الادخال يتم تحديث البيانات فى الاستعلام الخاص به مع مراجعة البرنامج فى حالة وجود اى اضافات اخرى ولكم جزيل الشكر والاحترام abdo_elctrec.rar

ان شاء الله جارى التجربة

استاذنا الفاضل أبوأحـمـد لقد اجتهدنا بالعمل على الكود الاصلى الذى سبق انك عملته واذا كان هناك تعديل او تصحيح نرجو اعطاء خبرتك Sub TR7el() Dim namsh As String Dim wk, wk2 As Worksheet Dim check As Boolean namsh = Format(ورقة1.Range("A3"), "yyyy-mm-dd") Set wk = Worksheets("ادخال البيانات") If namsh = Empty Then Beep MsgBox "لا يوجد يوم ", , "عفوا" wk.Range("A3").Select Exit Sub End If For Each wk2 In Worksheets If wk2.Name Like namsh Then check = True: Exit For Next If check = True Then MsgBox "تم ترحيل هذا اليوم مسبقا", , "عفوا" Exit Sub End If With ThisWorkbook .Sheets.Add(Before:=.Sheets(.Sheets.Count)).Name = namsh End With Set wk2 = Worksheets(namsh) wk.Range("U2:AD10").Copy wk2.Range("A2").PasteSpecial Paste:=xlPasteValues wk2.Range("A2").PasteSpecial Paste:=xlPasteFormats wk2.Range("h3:h10").Copy wk.Range("c3:c10").PasteSpecial Paste:=xlPasteValues wk2.Rows(2).RowHeight = 35 wk2.Rows("3:10").RowHeight = 25 wk2.Columns(1).ColumnWidth = 10 wk2.Columns(2).ColumnWidth = 7 wk2.Columns(3).ColumnWidth = 8 wk2.Columns(4).ColumnWidth = 8 wk2.Columns(5).ColumnWidth = 8 wk2.Columns(6).ColumnWidth = 8 wk2.Columns(7).ColumnWidth = 8 wk2.Columns(8).ColumnWidth = 8 wk2.Columns(9).ColumnWidth = 8 wk2.Columns(10).ColumnWidth = 8 MsgBox "تم الترحيل " wk.Activate SendKeys "{F2}" wk.Range("A3").Select wk.Range("A3") = Date wk.Range("A3") = "" 'wk.Range("e3:e10") = 0 'wk.Range("d3:d10") = 0 SendKeys "{ENTER}" End Sub

السادة الافاضل ارجو سعة صدركم بما اطلب وان شاء الله اجد الاجابة لديكم كما تعودنا من خبراء هذا المنتدى المطلوب نسخ الخلية AB3 من اليوم المرحل الى الخلية C3 من شيت ادخال البيانات حيث ان ارصيد السابق يجب يتغير يوميا حسب الاستهلاك اليومى وهذه هى المشكلة التى تواجهنى لقد جربت كافة المعادلات وبائت بالفشل ومرفق الملف بيان السولار اليومى لمزارع الامهات - Copy.xlsm

بالفعل هذا هو المطلوب ____ الف شكر استاذنا الفاضل

السادة الافاضل لكم منى التحية اريد استفسار عن كيفية اضافة كود بالموديل الموجود بالملف المرفق Rows(2).RowHeight = 35 Rows("3:10").RowHeight = 25 على ان يكون هذا التنسيق بالملف المطلوب ترحيله بيان السولار اليومى لمزارع الامهات (1).xlsm

الف شكر استاذنا الفاضل أبوأحـمـد هذا ما نريد والف شكر لحضرتك مرة ثانية وثالثة الى ما لا نهاية

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

لو هذا متاح ارجوا المساعدة فى الملف بيان السولار اليومى لمزارع الامهات.xlsx