سؤال :تمرير قيمة من خلال متغير خاص فى روتين عند استخدام FileDialog

[ابو جودي]

السلام عليكم 

واتتنى فكرة كتابة روتين عام متعدد  الخيارات لتكون وظيفته كالاتى 

احضار مسار ما
احضار مسار لملف محدد مع المرونة فى تغيير الامتداد تبعا للاستخدام المطلوب 

وتوقفت عند محاولة تمرير الامتداد من خلال استخدام المتغير strOptionExtension

وتحديد فى هذا السطر المن الكود

.Filters.Add "Select File", "*.jpg , *.png"

اريد استبدال جزء الامتداد على ان يكون بهذا الشكل 

.Filters.Add "Select File", strOptionExtension

وولاسف فشلت كل محاولاتى 

 

Function CustomPicker(Optional ByRef btOptionDialog As Byte = 0, Optional ByRef strOptionExtension As String = "")

Dim FileDialog  As Object
Dim sPath       As String
Dim sFile       As String

Select Case Nz(btOptionDialog, 0)
  'FilePicker
  Case Is = 0
    Set FileDialog = Access.Application.FileDialog(3)
      With FileDialog
        .allowmultiselect = False
        .Filters.Clear
        .Filters.Add "Select File", "*.jpg , *.png"
        If .show = -1 Then .Title = "Please select a File"
        CustomPicker = .SelectedItems(1)
      End With
  
  'FolderPicker
  Case Is = 1
    Set FileDialog = Access.Application.FileDialog(4)
      With FileDialog
        .allowmultiselect = False
        .Filters.Clear
        If .show = -1 Then .Title = "Please select a Folder"
        CustomPicker = .SelectedItems(1)
        End With
End Select
End Function

 

[Eng.Qassim]

وعليكم السلام استاذ @ابو جودي

هي محاولة ..استبدل السطر اعلاه ب 

If Len(strOptionExtension) > 0 Then
    .Filters.Add "Select File", strOptionExtension
 Else
     .Filters.Add "Select File", "*.jpg;*.png"
End If

الاستدعاء ..

Dim selectedFile As String
selectedFile = CustomPicker(0, "*.jpg;*.png")

 

[Foksh]

أخي الكريم @ابو جودي ، هل تقصد من كلامك أنك تريد اختيار صورة من مكان ما ، وحفظها مع امكانية تغيير اسم و امتداد الصورة ؟؟

هذه تجربة صغيرة خطرت في بالي ، وأعتقد نستطيع التطوير عليها لتلبي حاجتنا بجهود الإخوة 😊

من خلال فكرة اني اختار صورة شعار لبرنامجي من خلال نموذج بيانات الشركة وددت ان يكون مكان حفظ الصور في مكان خاص قريب من البرنامج ، وبطريقة ملتوية جعلت البرنامج عند اختيار الصورة يقوم بحفظها في المجلد بامتداد مصدره قائمة منسدلة قابلة للتعديل ..... شوف المرفق أفضل من شرحي 😂

والصحيح اني عندما رأيت أنك من فريق الموقع ترددت وخفت من الإجابة 😁 ( أمزح طبعاً 😅)

* ملاحظة :- طبعاً انا لم استخدم الكود الذي تعمل عليه.

 

Pic.accdb

تم تعديل سبتمبر 29, 2023 بواسطه Foksh

[ابو جودي]

10 دقائق مضت, Eng.Qassim said:

وعليكم السلام استاذ @ابو جودي

هي محاولة ..استبدل السطر اعلاه ب 

If Len(strOptionExtension) > 0 Then
    .Filters.Add "Select File", strOptionExtension
 Else
     .Filters.Add "Select File", "*.jpg;*.png"
End If

الاستدعاء ..

Dim selectedFile As String
selectedFile = CustomPicker(0, "*.jpg;*.png")

 

والله لى ساعتين اعمل الكود بالطريقة دى ومش عارف فى ايه سبحان الله 

جزاكم الله حيرا 

  
----------------------------

9 دقائق مضت, Foksh said:

والصحيح اني عندما رأيت أنك من فريق الموقع ترددت وخفت من الإجابة

انا ما بعض 

[Foksh]

1 دقيقه مضت, ابو جودي said:

انا ما بعض 

كل الإحترام والتقدير لك ، على رأي الإخوة السوريين في مثل عندهم يقول ( نهز الورد لحتى نشم ريحته 🌹 )

[ابو جودي]

16 دقائق مضت, Eng.Qassim said:

If Len(strOptionExtension) > 0 Then
    .Filters.Add "Select File", strOptionExtension
 Else
     .Filters.Add "Select File", "*.jpg;*.png"
End If

طيب يا باش مهندس انا اكتشفت السبب اخيرا فى المشكلة عندى 

انا كنت فاتح اكثر من قاعدة اعدل على واحدة واجرب على واحدة تانى خالص منشان هيك ما كنت احصل اى نتيجة وشكيت فى نفسي  ما انتبهت الا الان

وعلى كل جزاكم الله خيرا

ولارد بضاعتكم اليكم يا باش مهندس @Eng.Qassim 

سوف استخدم الكود بهذا الشكل 

If Nz(strOptionExtension, "") = "" Then .Filters.Add "Select File", "*.*" Else: .Filters.Add "Select File", strOptionExtension

 

[Eng.Qassim]

2 دقائق مضت, ابو جودي said:

سوف استخدم الكود بهذا الشكل

زيادة الخير خيرين يا بشمهندس محمد 

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

[ابو جودي]

1 ساعه مضت, Foksh said:

أخي الكريم @ابو جودي ، هل تقصد من كلامك أنك تريد اختيار صورة من مكان ما ، وحفظها مع امكانية تغيير اسم و امتداد الصورة ؟؟

هذه تجربة صغيرة خطرت في بالي ، وأعتقد نستطيع التطوير عليها لتلبي حاجتنا بجهود الإخوة 😊

من خلال فكرة اني اختار صورة شعار لبرنامجي من خلال نموذج بيانات الشركة وددت ان يكون مكان حفظ الصور في مكان خاص قريب من البرنامج ، وبطريقة ملتوية جعلت البرنامج عند اختيار الصورة يقوم بحفظها في المجلد بامتداد مصدره قائمة منسدلة قابلة للتعديل ..... شوف المرفق أفضل من شرحي 😂

والصحيح اني عندما رأيت أنك من فريق الموقع ترددت وخفت من الإجابة 😁 ( أمزح طبعاً 😅)

* ملاحظة :- طبعاً انا لم استخدم الكود الذي تعمل عليه.

طيب ايه رايك فى عمل مقارنة سريعة 

الكود بتاع حضرتك لازم ولابد وحتما انك تستدعى المكتبة ' Requires reference to Microsoft Office 11.0 Object Library.  

طبعا الرقم 11 سوف يتغير تبعا لاصدار الاوفيس يعنى يحصل مشكلة لو كان ' Requires reference to Microsoft Office 16.0 Object Library. وخيشتغل على اكسس اصدار اقل 

الكود المستخدم فى السؤال لا يعتمد على مكتبات 

[Foksh]

5 دقائق مضت, ابو جودي said:

طيب ايه رايك فى عمل مقارنة سريعة

😂 لستَ بحاجة للمقارنة أستاذي الفاضل ، فأنا وظفت الفكرة لتسير حسب رغبتي لا أن أسير حسب رغبتها ، هي كانت فكرة وعند تجربتها وجدت أنها قدمت لي ما أريد 😅

وبما أنني احتاج FileDialog ، فتوجب علي استخدام المكتبة.

وعلى سبيل النقاش فإن أي إضافة للمكتبات ستكون مرهونة ومحصورة فقط بنسخة الأوفيس التي تم تصميم المشروع عليها ، يعني لو أنا صممت برنامجي على أوفيس ٢٠١٦ ، فهل البرنامج لن يعمل على أوفيس ٢٠١٩ مثلاً ؟؟

وليس من باب التعالي لا والله ، ولكن لي شغف في تسيير الأمور كما أرغب حتى لو كانت مصممة لتسير باتجاه آخر 😉

تم تعديل سبتمبر 29, 2023 بواسطه Foksh

[Foksh]

12 دقائق مضت, ابو جودي said:

ايه رايك فى عمل مقارنة سريعة

ومداخلة سريعة اعذرني فيها بحثاً عن معلومة أوثق من تلك التي لدي.

 

لو انا صممت فكرتي ( الملف اللي انا ارفقته حصراً  ) على آكسيس ٢٠١٠ ، وفتحت الملف على جهاز تاني عليه إصدار ٢٠١٦ مثلاً ، فهل ستعمل أم لا ؟

 

علّي استفيد من هذا التوضيح 😊 ؛

[ابو جودي]

4 ساعات مضت, Foksh said:

ومداخلة سريعة اعذرني فيها بحثاً عن معلومة أوثق من تلك التي لدي.

 

لو انا صممت فكرتي ( الملف اللي انا ارفقته حصراً  ) على آكسيس ٢٠١٠ ، وفتحت الملف على جهاز تاني عليه إصدار ٢٠١٦ مثلاً ، فهل ستعمل أم لا ؟

 

علّي استفيد من هذا التوضيح 😊 ؛

نعم المكتبات المرهونة بإصدار الاوفيس عند اضافتها على اصدار اوفيس ومع فتح القاعدة باصدار أعلى من اللإصدار الذى تم التصميم واضافة المكتبات يتم تحديث خذخ المكتبات تبعا للاصدار الجديد والأحدث

طيب أين المشكلة 

عند فتح نفس القاعدة بإصدار اوفيس أقل فى الاصدار من أخر اصدار أوفيس تم فتح القاعدة به 

المكتبات يمكن أن يحدث لها Upgrade   ولكن ابدا لن يحدث لها downgrade

للتبسيط اكثر 

تم اصدار قاعدة بيانات اكسس  2000 عند محاولة فتح القاعدة على اكسس 2003 تعمل بنجاح ولو تم فتح نفس القاعدة على اكسس 2007 تعمل ايضا بنجاح
ولكن عند محاولة فتح نفس القاعدة على اكسس 2000 أو  اكسس 2003 لن تعمل وستتوقف المكتبة عن العمل 
وسوف تحصل على Missing References لاى نوع من المكتبات التى تعتمد على اصدار الاوفيس
طبعا هذه تمثل مشكلة كبيرة جدا فى استخدام القاعدة على شبكة محلية عند اختلاف نسخ الاوفيس

طبعا وللاهمية هذا كما اشرت مسبقا للمكتبات المرهونة برقم اصدار الاوفيس

 

الربط المسبق Early Binding:

1. ان تختار مكتبة الاكسل (طبعا لهذا المثال) ،

 

2. ثم الكود يكون شيء من هذا القبيل:

Dim oExcel As Excel.Application Set oExcel = CreateObject("Excel.Application") oExcel.Visible = True

والمشكلة هنا ،

انه اذا اخترت مكتبة اكسل الاقل (مثلا اكسل 😎 ، فأي كمبيوتر يحتوي على اكسل 8 او اكبر (9 ..12..15) فالمكتبة/البرنامج سوف يشتغل بطريقة صحيحه ،

بينما اذا كان عندك اكسل 6 ، فستحصل على خطأ ، ولن يعمل الكود

 

الميزة في هذه الطريقة  انها اسرع في العمل ،

والاهم من هذا ، انها تساعدك في اعطائك الاوامر (مثلا تكتب امر معين ثم تكتب نقطة . فتظهر لك الاوامر التي تستطيع استعمالها).

 

 

اما اذا استعملنا

الربط المتأخر Late Binding

فإننا لا نحتاج الى اختيار مكتبة الاكسل ، ونكتب الكود اعلاه هكذا ، والذي يشتغل على جميع اصدارات الاكسل:

Dim oExcel As Object Set oExcel = CreateObject("Excel.Application") oExcel.Visible = True

المشكلة هنا ،

اننا يجب ان نعتمد على انفسنا لعمل الكود ، فالاكسس لن يساعدنا ، وهو ابطأ نوعا ما ونسبيا من الطريقة الاولى

[Moosak]

21 ساعات مضت, ابو جودي said:

السلام عليكم 

واتتنى فكرة كتابة روتين عام متعدد  الخيارات لتكون وظيفته كالاتى 

احضار مسار ما
احضار مسار لملف محدد مع المرونة فى تغيير الامتداد تبعا للاستخدام المطلوب 

وتوقفت عند محاولة تمرير الامتداد من خلال استخدام المتغير strOptionExtension

وتحديد فى هذا السطر المن الكود

.Filters.Add "Select File", "*.jpg , *.png"

اريد استبدال جزء الامتداد على ان يكون بهذا الشكل 

.Filters.Add "Select File", strOptionExtension

وولاسف فشلت كل محاولاتى 

 

Function CustomPicker(Optional ByRef btOptionDialog As Byte = 0, Optional ByRef strOptionExtension As String = "")

Dim FileDialog  As Object
Dim sPath       As String
Dim sFile       As String

Select Case Nz(btOptionDialog, 0)
  'FilePicker
  Case Is = 0
    Set FileDialog = Access.Application.FileDialog(3)
      With FileDialog
        .allowmultiselect = False
        .Filters.Clear
        .Filters.Add "Select File", "*.jpg , *.png"
        If .show = -1 Then .Title = "Please select a File"
        CustomPicker = .SelectedItems(1)
      End With
  
  'FolderPicker
  Case Is = 1
    Set FileDialog = Access.Application.FileDialog(4)
      With FileDialog
        .allowmultiselect = False
        .Filters.Clear
        If .show = -1 Then .Title = "Please select a Folder"
        CustomPicker = .SelectedItems(1)
        End With
End Select
End Function

 

ما شاء الله عليكم تعمقتم في الموضوع وخضتم وتشعبتم في بحور المكتبات 😄🖐🏼️

 

أما أنا أعود بكم للموضوع الأصلي لأنه خطرت لي فكرة فما أردت لها أن تضيع في زحام الأفكار 😁👌🏼

الفكرة سلمكم الله هي أن تتيح للمستخدم كتابة أنواع الملفات في معامل الدالة على شكل مصفوفة هكذا ("jpg", "png", "pdf", "rar") ومن ثم يجمعها الكود بالشكل الصحيح ليتم استخدامها في الكود حسب الصياغة الصحيحة وإضافة النجمة لها * .. هكذا (jpg, *.png, *.pdf, *.rar.*)
ولعمل ذلك استعنت ب ChatGPT لكتابة الكود التالي مع الكثير من التعديلات لإيصال الفكرة لكم .. 🙂 

Function FilesTypes(ParamArray Types() As Variant) As String
    Dim combinedTypes As String
    Dim i As Integer
    
    ' Initialize the combined string
    combinedTypes = ""
    
    ' Loop through the array items and concatenate with the delimiter
    For i = LBound(Types) To UBound(Types)
        combinedTypes = combinedTypes & "*." & Types(i) & ", "
    Next i
    
    ' Remove the last ","
    If Len(combinedTypes) > 0 Then
    combinedTypes = Left(Trim(combinedTypes), Len(Trim(combinedTypes)) - 1)
    End If

    FilesTypes = IIf(Len(combinedTypes) > 0, combinedTypes, "*.*")
End Function

Sub testing()

Debug.Print FilesTypes("jpg", "png", "pdf", "rar")
'Result =  *.jpg, *.png, *.pdf, *.rar

Debug.Print FilesTypes()
'Result =  *.*

End Sub

ملاحظة مهمة : طبعا حسب إفادة موقع مايكروسوفت المعامل من نوع ParamArray يجب أن يكون في آخر المعاملات في الدالة وهو إختياري في جميع الأحوال ويمكن تركه فارغا .. ولا يصلح أن يتم استخدامه مع المعاملات من نوع   ByVal, ByRef, or Optional .  لذلك تركت لك مسألة التعامل مع المعامل btOptionDialog الذي في كودك الأصلي لتجد له حلا 😅🖐🏼️

مرجع : https://learn.microsoft.com/ar-sa/office/vba/language/reference/user-interface-help/function-statement

 

[Moosak]

21 ساعات مضت, Moosak said:

ولا يصلح أن يتم استخدامه مع المعاملات من نوع   ByVal, ByRef, or Optional .

فقط توضيح لهذه العبارة .. أحسست أنها أعطت معنى غير الذي أريده 😅🖐🏼️

طبعا يمكن إضافة متغيرات أخرى من أي نوع بيانات قبل المتغير ذي البادئة ParamArray ..

ولكن لا يمكن استخدام البادئات ByVal, ByRef, Optional قبلها ( فقط تكتب اسم المتغير ونوعه ).

لذلك يمكنك إضافة المتغير أو المعامل btOptionDialog  ولكن لا يمكن جعله Optional .