منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

نسخة كاملة : تغيير تسمية كل الصور الموجودة في مجلد
أنت حالياً تتصفح نسخة خفيفة من المنتدى . مشاهدة نسخة كاملة مع جميع الأشكال الجمالية .
السلام عليكم ورحمة الله
كيف يمكن ببساطة تغيير اسماء كل الصور الموجودة في مجلد بأرقام متسلسلة وبامتداد bmp نفسه دون تغيير مثلا    Bmp.2   Bmp.1
أريد لو سمحتم أبسط كود
 ولكم جزيل الشكر
وعليكم السلام ورحمة الله وبركاته

أهلا أخي الكريم , إستخدم هذا الإجراء :

PHP كود :
Private Sub RenameFilesInFolder(zFolderPath As String)

If 
Trim$(zFolderPath) = "" Then Exit Sub

If Right(zFolderPath1) <> "\" Then zFolderPath = zFolderPath & "\"
                                                        
Dim zFiles As String
Dim I As Long
                                                        
zFiles = Dir$(zFolderPath & "
*.bmp")
DoEvents

Do While Len(zFiles)
              
   I = I + 1
      
   Name zFolderPath & Trim$(zFiles) As zFolderPath & I & "
.bmp"
   DoEvents
         
   zFiles = Dir$
   DoEvents
           
Loop

End Sub 

وطريقة إستخدامة هكذا :

PHP كود :
Private Sub Command1_Click()

RenameFilesInFolder "C:\Folder1\"

End Sub 
السلام عليكم ورحمة الله

أولا اشكركم أخي الفاضل جزيل الشكر على هذا الكود البسيط والجميل

لكنني واجهت مشكلة أنه أحيانا يتجاوز  أرقاما  لا يكتبها ويظهر رسالة بعدم وجود الملف أو أن الملف 
موجود  Heart
فكيف يمكن التغلب على هذه المشكلة
بالمناسبة استخدمت التسمية مرتين الأولى التحويل إلى jpeg  والثانية إعادة التحويل إلى Bmp  وبقي 
المشكل قائما

تقبل مني أخي الفاضل أسمى عبارات التقدير والشكر
السلام عليكم

بعد الادن من اخي احمد اظافة بسيطة للكود

جرب التالي 

PHP كود :
Private Sub RenameFilesInFolder(zFolderPath As String)
If 
Trim$(zFolderPath) = "" Then Exit Sub
If Right(zFolderPath1) <> "\" Then zFolderPath = zFolderPath & "\"
Dim zFiles As String
Dim I As Long
 I = 0
 On Error Resume Next
zFiles = Dir$(zFolderPath & "
*.bmp")
DoEvents
Do While Len(zFiles)
 I = I + 1
Name zFolderPath & Trim$(zFiles) As zFolderPath & I & "
.bmp"
DoEvents
zFiles = Dir$
 DoEvents
Loop
End Sub
Private Sub Command1_Click()
RenameFilesInFolder "
C:\Folder1\"
End Sub 


بالتوفيق .
السلام عليكم
شكرا  جزيلا أخي [b]AL_BRNS[/b]  على مساندتكم القيمة
لكن المشكلة ما زالت قائمة

أوضح أكثر:
أنا أقوم ببرمجة برنامج لدراسة الحركات في الفيزياء  ومن خلال البرنامج
أقوم بحذف بعض الصور التي تكون دون فائدة عملية ، ثم أطلب من البرنامج أن يعيد
تسمية الصور الباقية بأرقام متسلسلة من 1 حتى نهايتها وتكون بنفس الامتداد

الآن المشكلة تكمن في أن هذا الكود حينما يعيد تسمية الصور أجد أن بعض الأرقام لا تظهر
أي أنه يتجاوز بعض الأرقام كأن يمر من الرقم 4 مثلا إلى الرقم 7
وبالتالي البرنامج لا يجد الصورة رقم 5 ورقم 6 على سبيل المثال

أين يكمن الخلل؟ لست أدري Heart
أهلا أخي الكريم , هذا تعديل للإجراء السابق , إحذف السابق وإستبدله بهذا  :

PHP كود :
Private Sub RenameFilesInFolder(zFolderPath As String)

If 
Trim$(zFolderPath) = "" Then Exit Sub

If Right(zFolderPath1) <> "\" Then zFolderPath = zFolderPath & "\"
                                                        
Dim zFiles As String
Dim zFilesList() As String
Dim I As Long
                                                        
zFiles = Dir$(zFolderPath & "
*.bmp")
DoEvents

Do While Len(zFiles)
              
   I = I + 1
   
   ReDim Preserve zFilesList(1 To I) As String
   
   zFilesList(I) = zFolderPath & Trim$(zFiles)
   DoEvents
         
   zFiles = Dir$
   DoEvents
           
Loop

For I = LBound(zFilesList) To UBound(zFilesList)
    
    If Dir$(zFilesList(I)) <> "" Then
       Name zFilesList(I) As zFolderPath & I & "
.bmp"
       DoEvents
    End If
    
Next

End Sub 
السلام عليكم ورحمة الله وبركاته
أخي الفاضل أحمد منصور والإخوة الكرام الذين تفاعلوا مع الموضوع، لا يكفي الشكر
مهما كان شكله
لكن أسأل الله العلي القدير أن يدخلكم جنات عدن تجري من تحتها الأنهار
فعلا نعم الإخوة، ونعم الرجال
جازاكم الله كل خير وأصلح لكم ذرياتكم وحفظ والديكم إن كانوا أحياء وأطال الله في أعمارهم 
ومتعكم بهم وإن كانوا قد التحقوا بالرفيق الأعلى فأسأل الله لهم الجنة والرحمة الواسعة