Mohamed 188

السلام عليكم شكرا لحضرتك استاذنا الفاضل اشكرك يا استاذ / سليم

السلام عليكم استاذى الفاضل شكرا لحضرتك انا اريد عندما اختار عنصر من الكمبوكس مثلا Ship Mode تظهر فى قائمه الليست بوكس اللى تحتو عناصر ( Ship Mode) Second Class Standard Class First Class عندما اختار اى عنصر ثم فلتر تظهر فى قائمه الليست بوكس هذه العناصر فقط وشكر لحضرنك ارجو المساعده فى ذلك

السلام عليكم عند تشغيل الفورم يعطى رساله (Method range of opject ) الرجاء المساعده فى حل مشكله run time error 1004 - FILTER DATA (2).xlsm

للرفع

السلام عليكم الرجاء المساعدة فى ترحيل البيانات الى الشيت حتى يعمل الفورم بشكل صحيح System.xlsm

السلام عليكم الرجاء مساعدتى فى تصحيح خطا بالكود يعطى خطا فى هذا السطر 'Balance Qty 'Purchase Qty - 'Sales Qty .List(c, 6) = Val(.List(c, 2)) - Val(.List(c, 4)) If Val(.List(c, 6)) >= 1 Then 'Balance Amount 'Purchase Amount /Purchase Qty *Balance Qty .List(c, 7) = Val(.List(c, 3)) / Val(.List(c, 2)) * Val(.List(c, 6)) الرجاء المساعده وشكرا لحضرتك مرفق البرنامج برنامج1.xlsm

للرفع

السلام عليكم عمل ترقيم تلقائى تكست بوكس 1 يبدا ب 00001-01 Hotel reservation program00000001.xlsm

السلام عليكم يوزر فورم 6 عندما اضغط على الغرفة المشغولة يظهر الفورم فارغ الرجاء مساعدة عند الضغط على الغرفة الفارغة يظهر الفورم فارغ وعندما تكون مشغولة يملى الفورم تلقائى من شيت Database Hotel reservation program00000001.xlsm

السلام عليكم الرجاء مساعدتى فى تصحيح الخطا عند تشغيل الفورم يعطى رساله خطا LATIHAN - FILTER DATA.xlsm

للرفع

السلام عليكم هذا الكود يعطى رساله خطا compile error Block if without end if Private Sub CmdSaveChanges_Click() 'edit ThisWorkbook.Activate If Me.TextBox1.Value = "" Then If Me.TextBox2.Value = "" Then If Me.TextBox3.Value = "" Then If Me.ComboBox5.MatchFound = False Then '====check date entry '== dtval = Val(Format(Me.TextBox2.Value, "0")) mindt = 40909 maxdt = Val(Format(Date + 1, "0")) If dtval < mindt Then If dtval > maxdt Then End If With Sheet13 invs = Me.ComboBox5.Value invn = Me.TextBox1.Value fc = Application.WorksheetFunction.CountIfs(Sheet13.Range("C2:C5000"), invs, Sheet13.Range("B2:B5000"), invn) If fc < 1 Then: MsgBox " ÑÞã ÇáÍÑßÉ åÐÇ ÛíÑ ãæÌæÏ Çæ ãßÑÑ ÝÖáÇ ÊÇßÏ ãä ÇáÑÞã ", vbCritical, "FADEL NASSER ": Exit Sub confir = MsgBox("åá ÊÑíÏ ÍÝÙ ÇáÊÚÏíáÇÊ Úáì ÇáÍÑßÉ... ¿", vbOKCancel, "FADEL NASSER ") If confir = vbCancel Then: Exit Sub Application.ScreenUpdating = False Me.TextBox2.Text = .Cells(lastrow, "A").Value 'date Me.TextBox2.Text = Format(Me.TextBox2.Text, "yyyy/mm/dd") 'f date Me.TextBox1.Value = .Cells(lastrow, "B").Value 'invn Me.ComboBox5 = .Cells(lastrow, "C").Value 'invs Me.ComboBox1.Value = .Cells(lastrow, "D") 'customer Me.ComboBox6.Text = .Cells(lastrow, "E") 'wazalik Me.TextBox3.Text = .Cells(lastrow, "F") 'mandob name Me.Label24.Caption = .Cells(lastrow, "G") 'payment method Me.TextBox7.Text = .Cells(lastrow, "H") 'bank name Me.TextBox6.Text = .Cells(lastrow, "I") 'shiak _no If invs = shSupport.Range("j2").Value _ Or invs = shSupport.Range("j3").Value Then Me.TextBox3.Text = .Cells(lastrow, "F") 'madfoaat sanad Me.TextBox6.Value = .Cells(lastrow, "E") 'khasm ElseIf invs = Support.Range("J1").Value _ Or invs = Support.Range("J1").Value Then Me.TextBox3.Value = .Cells(lastrow, "F") 'discount bai3 and shera2 End If End With Me.TextBox2.Value = Format(Date, "yyyy/mm/dd") Me.TextBox1.Text = "" Me.ComboBox5.Text = "" Me.ComboBox1.Text = "" Me.ComboBox6.Text = "" Me.TextBox3.Text = "" Me.Label24.Caption = "" Me.TextBox7.Text = "" Me.TextBox6.Text = "" Me.ComboBox4.Value = invs Me.TextBox10.Value = invn CmdSearchHaraka_Click MsgBox " ÊãÊ ÚãáíÉ ÊÚÏíá ÇáÍÑßÉ ÈäÌÇÍ " Application.ScreenUpdating = True End Sub 01-00001.xlsm

شكرا لحضرتك أ / على المصرى

يعطى لون اصفر على السطر (fc = Application.WorksheetFunction.CountIfs(.Range("C2:C5000"), invs, .Range("B2:B5000"), invn Private Sub CmdSearchHaraka_Click() ThisWorkbook.Activate With Sheet02 invs = Me.ComboBox4.Value invn = Me.TextBox10.Value If invs = "" Or invn = "" Then: MsgBox "اختر نوع الحركة او اكتب رقم الحركة ", vbCritical, "FADEL NASSER ": Exit Sub (fc = Application.WorksheetFunction.CountIfs(.Range("C2:C5000"), invs, .Range("B2:B5000"), invn If fc < 1 Then: MsgBox " رقم الحركة هذا غير موجود فضلا تاكد من الرقم ", vbCritical, "FADEL NASSER " _ : Me.TextBox10.Value = "": Me.TextBox10.SetFocus: Exit Sub Application.ScreenUpdating = False .Range("$C$1:$I$2").AutoFilter Field:=2, Criteria1:=invs .Range("$B$1:$1$2").AutoFilter Field:=1, Criteria1:=invn lastrow = .Range("B5000").End(xlUp).row .Range("$A$2:$I$2").AutoFilter Me.TextBox2.Text = .Cells(lastrow, "A").Value 'date Me.TextBox2.Text = Format(Me.TextBox2.Text, "yyyy/mm/dd") 'f date Me.TextBox1.Value = .Cells(lastrow, "B").Value 'invn Me.ComboBox5 = .Cells(lastrow, "C").Value 'invs Me.ComboBox1.Value = .Cells(lastrow, "D") 'customer Me.ComboBox6.Text = .Cells(lastrow, "E") 'wazalik Me.TextBox3.Text = .Cells(lastrow, "F") 'mandob name Me.Label24.Caption = .Cells(lastrow, "G") 'payment method Me.TextBox7.Text = .Cells(lastrow, "H") 'bank name Me.TextBox6.Text = .Cells(lastrow, "I") 'shiak _no If invs = shSupport.Range("j3").Value _ Or invs = shSupport.Range("j2").Value Then Me.TextBox3.Text = .Cells(lastrow, "F") 'madfoaat sanad Me.TextBox6.Value = .Cells(lastrow, "E") 'khasm ElseIf invs = shSupport.Range("J1").Value _ Or invs = shSupport.Range("J1").Value Then Me.TextBox3.Value = .Cells(lastrow, "F") 'discount bai3 and shera2 End If End With If Me.Label24.Caption = shSupport.Range("J4").Value Then OptionButton3.Value = True If Me.Label24.Caption = shSupport.Range("J5").Value Then OptionButton4.Value = True If Me.Label24.Caption = shSupport.Range("J6").Value Then OptionButton5.Value = True Me.ComboBox5.Enabled = False Me.TextBox1.Enabled = False Application.ScreenUpdating = True End Sub 01-00001.xlsm

السلام عليكم عندما اختار اى عنصر من الكمبوكس لا تظهر فى الليست بوكس Dim r As Integer Sheets("Database").Activate If Me.LsAdAm.ListIndex = -1 Then MsgBox " No selection made" ElseIf Me.LsAdAm.ListIndex >= 0 Then r = Me.LsAdAm.ListIndex With Me .TxtBalance.Value = LsAdAm.List(r, 0) .TxtDeparture.Value = LsAdAm.List(r, 1) .TxtArrival.Value = LsAdAm.List(r, 2) .TxtRoomType.Value = LsAdAm.List(r, 3) .TxtRoomNo.Value = LsAdAm.List(r, 4) .TxtCompany.Value = LsAdAm.List(r, 5) .TxtGuestName.Value = LsAdAm.List(r, 6) .TxtFilio.Value = LsAdAm.List(r, 7) End With End If End Sub مرفق الملف الرجاء المساعده Book .xlsm

شكرا لحضرتك استبدلت ب sheet1 ولكن الفورم لا يعمل الرجاء المساعده حتى يعمل الفورم بشكل صحيح Book .xlsm

الرجاء المساعده فى حل مشكله هذة الرساله Book .xlsm

شكرا لحضرتك أ/ الرائد الف شكر

السلام عليكم عندى مشكله فى اليوزر فورم عندما تختار شهر يكتب تاريخ البدايه صح وتاريخ النهايه خطا الرجاء المساعده فى حل هذا الخطا BOOK--Excel.xlsm

الرجاء المساعده فى حل عدم ظهور عناصر شيت Database فى الليست بوكس userform3 Excel File.xlsm

السلام عليكم الرجاء المساعدة فى تصحيح خطا فى الاكواد Add New Booking - Look up Booking Edit Existing Booking rorrrr Form..xlsm

الرجاء من الاساتذة الافاضل تصحيح عمل الفلتره New Microsoft Excel Worksheet.xlsx

السلام عليكم أ / محمد شكرا لحضرتك مرفق البرنامج يوجد بعض الاخطاء فى النماذج الرجاء المساعده حتى يعمل بشكل صحيح فانا احتاجه فى شغلى ورينا يجعلوا فى ميزان حسناتك New Microsoft Access Database.rar

Option Compare Database Public Room As Long Public State As FormState 'Variable used to determine on how the form used Public PK As Long 'Variable used to get what record is going to edit Public PopupPK As String Public AmountPaid As Currency 'Amount paid from frmPayment Public OtherCharges As Currency Public blnChangeRoom As Boolean Dim HaveAction As Boolean 'Variable used to detect if the user perform some action Dim RS As New ADODB.Recordset Private Sub DisplayForEditing() On Error GoTo err With RS txtFolioNumber.Value = .Fields("FolioNumber") txtRCardNo.Value = .Fields("RCardNo") txtLastName.Value = getValueAt("SELECT LastName FROM Customers WHERE CustomerID = " & RS.Fields("CustomerID"), "LastName") txtFirstName.Value = getValueAt("SELECT FirstName FROM Customers WHERE CustomerID = " & RS.Fields("CustomerID"), "FirstName") txtAddress.Value = .Fields("Address") dcCountry.Value = .Fields("CountryID") If RS.Fields("CompanyID") <> "" Then _ txtCompany.Value = getValueAt("SELECT Company FROM Company WHERE CompanyID = " & RS.Fields("CompanyID"), "Company") dcIDType.Value = .Fields("IDTypeID") txtIDNumber.Value = .Fields("IDNumber") txtRoomNumber.Value = .Fields("RoomNumber") dtpDateIn.Value = .Fields("DateIn") If State = adStateAddMode Or State = adStateEditMode Then If .Fields("DateOut") >= Date Then dtpDateOut.Value = .Fields("DateOut") ElseIf .Fields("DateIn") = Date Then dtpDateOut.Value = dtpDateIn.Value + 1 Else dtpDateOut.Value = Date End If Else dtpDateOut.Value = .Fields("DateOut") End If dcRateType.Value = .Fields("RateType") txtRate.Value = toMoney(.Fields("Rate")) txtOtherCharges.Value = toMoney(.Fields("OtherCharges")) txtDiscount.Value = .Fields("Discount") txtAmountPaid.Value = toMoney(.Fields("AmountPaid")) txtDays.Value = dtpDateOut.Value - dtpDateIn.Value '.Fields("Days") txtAdults.Value = .Fields("Adults") txtChildrens.Value = .Fields("Childrens") dcBusSource.Value = .Fields("BusinessSourceID") dcVehicle.Value = .Fields("VehicleID") txtVehicleModel.Value = .Fields("VehicleModel") txtPlateNo.Value = .Fields("PlateNo") txtNotes.Value = .Fields("Notes") End With hsDays.Value = txtDays.Text hsAdults.Value = txtAdults.Text hsChildrens.Value = txtChildrens.Text StatusBar1.Panels(2).Value = "Check In By: " & getValueAt("SELECT UserID FROM Users WHERE PK = " & RS.Fields("CheckInBy"), "UserID") StatusBar1.Panels(4).Value = "Business Source: " & dcBusSource.Text Exit Sub err: If err.Number = 94 Then Resume Next prompt_err err, Name, "DisplayForEditing" Screen.MousePointer = vbDefault End Sub Private Sub cmdCancel_Click() On Error GoTo err CurrentProject.Connection.BeginTrans CurrentProject.Connection.Execute "DELETE FolioNumber " & _ "From [Rate Per Period] " & _ "WHERE FolioNumber='" & txtFolioNumber.Text & "'" CurrentProject.Connection.Execute "INSERT INTO [Rate Per Period] " & _ "SELECT [Rate Per Period Temp].* " & _ "FROM [Rate Per Period Temp] " & _ "Where ((([Rate Per Period Temp].FolioNumber) = '" & txtFolioNumber.Text & "')) " & _ "ORDER BY [Rate Per Period Temp].Date;" CurrentProject.Connection.CommitTrans DoCmd.Close acForm, Me.Name Exit Sub err: CurrentProject.Connection.RollbackTrans prompt_err err, Name, "CmdCancel_Click" Screen.MousePointer = vbDefault End Sub Private Sub cmdChangeRoom_Click() On Error GoTo err Dim OldRoomNumber As Integer CN.BeginTrans With frmChangeRoom OldRoomNumber = txtRoomNumber.Text .txtFrom = OldRoomNumber .Show vbModal End With If blnChangeRoom = False Then Exit Sub ChangeValue CN, "Rooms", "RoomStatusID", 2, True, "WHERE RoomNumber = " & txtRoomNumber.Text ChangeValue CN, "Rooms", "RoomStatusID", 3, True, "WHERE RoomNumber = " & OldRoomNumber CN.Execute "UPDATE [Inventory] SET [Inventory].RoomNumber = " & txtRoomNumber.Text & " " & _ "WHERE RoomNumber=" & OldRoomNumber & " AND ID='" & txtFolioNumber.Text & "' AND Status='Check In'" CN.CommitTrans Exit Sub err: CN.RollbackTrans prompt_err err, Name, "CmdChangeRoom_Click" Screen.MousePointer = vbDefault End Sub Private Sub CmdCheckIn_Click() Dim strCaption As String Dim RoomNumber As Integer strCaption = cmdCheckInOut.Caption RoomNumber = txtRoomNumber.Text Call SaveAdd If HaveAction = False Then Exit Sub End If If State = adStateAddMode Then MsgBox "New record has been successfully saved.", vbInformation Unload frmCheckIn Else MsgBox "Changes in record has been successfully saved.", vbInformation Unload frmCheckIn End If If strCaption = "Check Out" Then With frmCheckOut .RoomNumber = RoomNumber .AutoCheckOut = False .Show vbModal End With End If End Sub Private Sub CmdPrint_Click() If State = adStatePopupMode Then GoSub JumpHere End If If MsgBox("This will save the record before printing a folio. " & vbCrLf & vbCrLf & "Are you sure you want to continue?", vbYesNo + vbInformation) = vbYes Then Call SaveAdd Else Exit Sub End If JumpHere: With frmReports .strReport = "Folio" If State = adStatePopupMode Then .strWhere = "{qry_RPT_Customers.FolioNumber} = '" & txtFolioNumber.Text & "' AND {qry_RPT_Customers.Status} = 'Check Out'" Else .strWhere = "{qry_RPT_Customers.FolioNumber} = '" & txtFolioNumber.Text & "' AND {qry_RPT_Customers.Status} = 'Check In'" End If frmReports.Show vbModal End With End Sub Private Sub cmdUpdateDelete_Click() If cmdUpdateDelete.Caption = "Update" Then Call SaveAdd If State = adStateAddMode Then MsgBox "New record has been successfully saved.", vbInformation ' Unload frmCheckIn Else MsgBox "Changes in record has been successfully saved.", vbInformation ' Unload frmCheckIn End If End If End Sub Private Sub Command84_Click() If txtDays.Value = 1 Then Exit Sub Else txtDays.Value = txtDays.Value - 1 End If End Sub Private Sub Command85_Click() txtDays.Value = txtDays.Value + 1 End Sub Private Sub Command86_Click() If txtDays.Value = 1 Then Exit Sub Else txtDays.Value = txtDays.Value - 1 End If End Sub Private Sub Command87_Click() txtDays.Value = txtDays.Value + 1 End Sub Private Sub Command82_Click() On Error GoTo Err_Command82_Click If txtDays.Value = 1 Then Exit Sub Else txtDays.Value = txtDays.Value - 1 End If Exit_Command82_Click: Exit Sub Err_Command82_Click: MsgBox err.Description Resume Exit_Command82_Click End Sub Private Sub Command83_Click() On Error GoTo Err_Command83_Click txtDays.Value = txtDays.Value + 1 Exit_Command83_Click: Exit Sub Err_Command83_Click: MsgBox err.Description Resume Exit_Command83_Click End Sub Private Sub Form_Load() End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) lblAmountPaid.FontUnderline = False lblRatePerPeriod.FontUnderline = False lblOtherCharges.FontUnderline = False End Sub Private Sub SaveAdd() On Error GoTo err Dim rsCustomers As New Recordset Dim CustomerID As Integer Dim CompanyID As Integer If Trim(txtLastName.Text) = "" Or Trim(txtFirstName.Text) = "" Then MsgBox "Please complete the name of a guest.", vbInformation Exit Sub End If CN.BeginTrans 'Save customer's record With rsCustomers .Open "SELECT * FROM Customers WHERE LastName = '" & txtLastName.Text & "' AND FirstName = '" & txtFirstName.Text & "'", CN, adOpenStatic, adLockOptimistic If .RecordCount > 0 Then txtLastName.Tag = .Fields("CustomerID") Else .AddNew CustomerID = getIndex("Customers") txtLastName.Tag = CustomerID .Fields("CustomerID") = CustomerID .Fields("LastName") = txtLastName.Text .Fields("FirstName") = txtFirstName.Text .Update End If .Close If txtCompany.Text = "" Then GoSub ContinueSave 'Save company's record .Open "SELECT * FROM Company WHERE Company = '" & txtCompany.Text & "'", CN, adOpenStatic, adLockOptimistic If .RecordCount > 0 Then txtCompany.Tag = .Fields("CompanyID") Else .AddNew CompanyID = getIndex("Company") txtCompany.Tag = CompanyID .Fields("CompanyID") = CompanyID .Fields("Company") = txtCompany.Text .Update End If .Close End With ContinueSave: If State = adStateAddMode Then RS.AddNew RS.Fields("FolioNumber") = txtFolioNumber.Text RS.Fields("CheckInBy") = CurrUser.USER_PK RS.Fields("AddedByFK") = CurrUser.USER_PK Else RS.Fields("DateModified") = Now RS.Fields("LastUserFK") = CurrUser.USER_PK End If With RS .Fields("RCardNo") = txtRCardNo.Text .Fields("CustomerID") = txtLastName.Tag .Fields("Address") = txtAddress.Text .Fields("CountryID") = dcCountry.BoundText .Fields("CompanyID") = IIf(txtCompany.Tag = "", Null, txtCompany.Tag) .Fields("IDTypeID") = dcIDType.BoundText .Fields("IDNumber") = txtIDNumber.Text .Fields("RoomNumber") = txtRoomNumber.Text .Fields("DateIn") = dtpDateIn.Value .Fields("DateOut") = dtpDateOut.Value .Fields("RateType") = dcRateType.BoundText .Fields("Rate") = txtRate.Text .Fields("OtherCharges") = txtOtherCharges.Text .Fields("Discount") = txtDiscount.Text .Fields("AmountPaid") = txtAmountPaid.Text .Fields("Days") = txtDays.Text .Fields("Adults") = txtAdults.Text .Fields("Childrens") = txtChildrens.Text .Fields("Total") = txtTotal.Text .Fields("BusinessSourceID") = dcBusSource.BoundText .Fields("VehicleID") = IIf(dcVehicle.BoundText = "", Null, dcVehicle.BoundText) .Fields("VehicleModel") = txtVehicleModel.Text .Fields("PlateNo") = txtPlateNo.Text .Fields("Notes") = txtNotes.Text .Update End With '---------------------------- 'Delete record from Inventory and add a new check in/out date CN.Execute "DELETE ID, Status " & _ "From [Inventory] " & _ "WHERE ID='" & txtFolioNumber.Text & "' AND Status='Check In'" Dim dtpStartDate As Date dtpStartDate = dtpDateIn.Value Do Until dtpStartDate = dtpDateOut.Value CN.Execute "INSERT INTO [Inventory] ( ID, RoomNumber, [Date], CustomerID, Status ) " & _ "VALUES ('" & txtFolioNumber.Text & "', " & txtRoomNumber.Text & ", #" & dtpStartDate & "#, " & txtLastName.Tag & ", 'Check In')" dtpStartDate = dtpStartDate + 1 Loop '---------------------------- ChangeValue CN, "Rooms", "RoomStatusID", 2, True, "WHERE RoomNumber = " & txtRoomNumber.Text Call frmPayment.cmdSave_Click Call frmOtherCharges.cmdSave_Click If txtCompany.Text <> "" Then Dim rsAccRec As New Recordset With rsAccRec .Open "SELECT * FROM [Accounts Receivable] WHERE CompanyID = " & txtCompany.Tag & " AND FolioNumber = '" & txtFolioNumber & "'", CN, adOpenStatic, adLockOptimistic If .RecordCount > 0 Then .Fields("Debit") = txtBalance.Text Else .AddNew .Fields("CompanyID") = txtCompany.Tag .Fields("FolioNumber") = txtFolioNumber.Text .Fields("Credit") = txtBalance.Text End If .Update End With ElseIf State = adStateEditMode Then 'delete record from accounts receivable table since the company field becomes blank. CN.Execute "DELETE [Accounts Receivable].FolioNumber " & _ "From [Accounts Receivable] " & _ "WHERE FolioNumber= '" & txtFolioNumber.Text & "'" End If CN.CommitTrans HaveAction = True Exit Sub err: CN.RollbackTrans prompt_err err, Name, "cmdSave_Click" Screen.MousePointer = vbDefault End Sub Private Sub cmdLookupComp_Click() With frmCompanyLookup Set .RefForm = Me .Show vbModal End With End Sub Private Sub cmdLookupCust_Click() With frmCustomerLookup Set .RefForm = Me .Show vbModal End With End Sub

شكرا جزيلا اخى احمد