((( folks ))) قام بنشر أكتوبر 31 مشاركة قام بنشر أكتوبر 31 (معدل) السلام عليكم ورحمة الله وبركاته عند فتح الفورم بالأوفيس 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 تم تعديل أكتوبر 31 بواسطه ((( folks ))) رابط هذا التعليق شارك More sharing options...
أفضل إجابة عبدالله بشير عبدالله قام بنشر نوفمبر 1 أفضل إجابة مشاركة قام بنشر نوفمبر 1 (معدل) وعليكم السلام ورحمة الله وبركاته لو ارفقت لنا ملفك لاختصرت الوقت او ارفقت الجملة التى بها خطأ لسهلت لنا الامر يدون ملف محاولات قد تصيب وقد تخطئ ريما السبب من جملة FILESEARCH والتي اعتقد انها غير متوافقة مع الاصدارات بعد 2003 ( غير متاكد منها) سنفترض ان الامر منها فيكون تعديل الكود كالتالى Private Sub FrstChnge(combo1 As ComboBox, combo2 As ComboBox) Dim val As String Dim Namey As String Dim fso As Object Dim folder As Object Dim file As Object combo2.Clear If combo1.Value = "" Then MsgBox "الرجاء اختيار شيت من القائمة", vbExclamation Exit Sub End If val = ThisWorkbook.Path & "\" & combo1.Value & "\Ser" Set fso = CreateObject("Scripting.FileSystemObject") If fso.FolderExists(val) Then Set folder = fso.GetFolder(val) For Each file In folder.Files If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then Namey = file.Name Namey = Left(Namey, Len(Namey) - 5) ' إزالة الامتداد .xlsx combo2.AddItem Namey End If Next file Else MsgBox "المجلد غير موجود: " & val, vbExclamation End If Set fso = Nothing Set folder = Nothing Set file = Nothing End Sub او جرب الكود التالى Private Sub FrstChnge(combo1 As ComboBox, combo2 As ComboBox) Dim val As String Dim filePath As String Dim fileName As String val = combo1.Value combo2.Clear If val = "" Then Exit Sub filePath = ThisWorkbook.Path & "\" & val & "\Ser\" fileName = Dir(filePath & "*.xls*") Do While fileName <> "" combo2.AddItem Left(fileName, Len(fileName) - 4) fileName = Dir Loop End Sub اذا لم بعمل ارفق ملفك وفقك الله تم تعديل نوفمبر 1 بواسطه عبدالله بشير عبدالله 1 1 رابط هذا التعليق شارك More sharing options...
((( folks ))) قام بنشر نوفمبر 1 الكاتب مشاركة قام بنشر نوفمبر 1 6 ساعات مضت, عبدالله بشير عبدالله said: Private Sub FrstChnge(combo1 As ComboBox, combo2 As ComboBox) Dim val As String Dim filePath As String Dim fileName As String val = combo1.Value combo2.Clear If val = "" Then Exit Sub filePath = ThisWorkbook.Path & "\" & val & "\Ser\" fileName = Dir(filePath & "*.xls*") Do While fileName <> "" combo2.AddItem Left(fileName, Len(fileName) - 4) fileName = Dir Loop End Sub بارك الله فيك يا استاذى ونفع بك وبعلمك الأمة وجعل عملك هذا فى ميزان حسناتك يوم القيامة 1 رابط هذا التعليق شارك More sharing options...
((( folks ))) قام بنشر نوفمبر 1 الكاتب مشاركة قام بنشر نوفمبر 1 (معدل) اقتباس ريما السبب من جملة FILESEARCH والتي اعتقد انها غير متوافقة مع الاصدارات بعد 2003 ( غير متاكد منها) قول حضرتك صحيح 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 عذراً ليس بالإمكان رفع الملف لأنه خاص بالمؤسسة تم تعديل نوفمبر 2 بواسطه ((( folks ))) رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان