((( folks )))

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

قول حضرتك صحيح 100% بعد إذنك حضرتك تتكرم بتعديل بباقى الجمل لأنها تتعارض مع إصدار 2003 Private Sub TamamUpdate() Dim val, x As String ComboBox28.Clear If OptionButton1.Value = True Then val = ThisWorkbook.Path & "\Tamam\ONE\" ElseIf OptionButton2.Value = True Then val = ThisWorkbook.Path & "\Tamam\ALL\" End If With Application.FileSearch .NewSearch .LookIn = val .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Namey = .FoundFiles(i) For nn = Len(Namey) To 1 Step -1 If Mid(Namey, nn, 1) = "\" Then Namey = Right(Namey, Len(Namey) - nn) Namey = Left(Namey, Len(Namey) - 4) End If Next nn ComboBox28.AddItem Namey Next i End If End With End Sub Private Sub Removedfrm() val = ThisWorkbook.Path & "\" & ShNm & "\Ser" FlNo = 0 With Application.FileSearch .NewSearch .LookIn = val .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Namey = .FoundFiles(i) For nn = Len(Namey) To 1 Step -1 If Mid(Namey, nn, 1) = "\" Then Namey = Right(Namey, Len(Namey) - nn) End If Next nn LwF(i) = Namey Next i End If FlNo = .FoundFiles.Count End With For ShNo = 2 To ShNoE Tmam_Wbk.Sheets(ShNo).Select RTmpE = CLng(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row) - 1 ShNm = ActiveSheet.Name For Rw = 2 To RTmpE If InStr(ActiveSheet.Cells(Rw, 1).Value, "إجمالى") Then GoTo Nxt30 Kat = ActiveSheet.Cells(Rw, 1).Value All_Wbk.Activate RAllE = 0 For i = 2 To LRow If ActiveSheet.Cells(i, 6).Value = ComboBox28.Value Then If ActiveSheet.Cells(i, 1).Value = ShNm Then If ActiveSheet.Cells(i, 3).Value = Kat Then RAllE = RAllE + 1 End If End If End If Next i Tmam_Wbk.Activate ActiveSheet.Cells(Rw, 5).Value = RAllE Nxt30: Next Rw Next ShNo End Sub عذراً ليس بالإمكان رفع الملف لأنه خاص بالمؤسسة

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

السلام عليكم ورحمة الله وبركاته عند فتح الفورم بالأوفيس 2003 لا تظهر المشكلة ولكن عنده فتحه بإصدار أعلى تظهر المشكلة Private Sub FrstChnge(combo1, combo2) Dim val As String Dim ARY As Variant val = combo1.Value combo2.Clear If val = "" Then Exit Sub val = ThisWorkbook.Path & "\" & val & "\Ser" With Application.FileSearch .NewSearch .LookIn = val .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Namey = .FoundFiles(i) For nn = Len(Namey) To 1 Step -1 If Mid(Namey, nn, 1) = "\" Then Namey = Right(Namey, Len(Namey) - nn) Namey = Left(Namey, Len(Namey) - 4) End If Next nn combo2.AddItem Namey Next i End If End With End Sub