كود لطباعة استمارة من فولدر خارجي

[محمد التميمي]

السلام عليكم:

اخواني الكرام محتاج كود لطباعة استمارة من فولدر خارجي طبقا للمثال المرفق . برابط (D:\CARDS\New)

مع فائق الشكر والتقدير

 

CARDS.rar

تم تعديل أبريل 4, 2025 بواسطه محمد التميمي

[Eng.Qassim]

جرب هذه المحاولة

 

CARDS.rar

[محمد التميمي]

3 ساعات مضت, Eng.Qassim said:

جرب هذه المحاولة

 

CARDS.rar 169.69 kB · 7 downloads

السلام عليكم

شكرا جزيلا استاذ قاسم على المرور والاجابة على طلبي ..

لكن الجواب المطروح من جنابكم الكريم لا يلائم ما عندي واريد الاستغناء عن (txtBrows) وزر معاينة الاستمارة والبقاء على زر طباعة الاستمارة فقط والطباعة بشكل مباشر للاستمارة الموجودة في فولدر (New) الموجود مع مرفقات القاعدة.

علما انه تم طباعة الاستمارة من خلال (txtBrows) لكن بحجم نصف A4 لماذا ؟

مع فائق الشكر والتقدير....

[Foksh]

مداخلة سريعة ، هل اسم ملف الإستمارة ثابت ؟؟

على العموم ، جرب هذه الفكرة أيضاً اشتقاقاً من فكرة المهندس @Eng.Qassim ..

Private Sub Comaand4_Click()
    On Error GoTo ErrorHandler
    
    Dim dbPath As String
    Dim localNewFolder As String
    Dim defaultNewFolder As String
    Dim imagePath As String
    Dim imgFile As String
    
    dbPath = CurrentProject.Path
    
    localNewFolder = dbPath & "\New"
    defaultNewFolder = "D:\CARDS\New"
    
    If Dir(localNewFolder, vbDirectory) <> "" Then
        imgFile = Dir(localNewFolder & "\*.*")
        
        Do While imgFile <> ""
            Select Case LCase(Right(imgFile, 4))
                Case ".jpg", ".jpeg", ".bmp", ".png", ".gif", ".tif"
                    imagePath = localNewFolder & "\" & imgFile
                    Exit Do
                Case Else
                    imgFile = Dir()
            End Select
        Loop
    End If
    
    If imagePath = "" Then
        If Dir(defaultNewFolder, vbDirectory) <> "" Then
            imgFile = Dir(defaultNewFolder & "\*.*")
            
            Do While imgFile <> ""
                Select Case LCase(Right(imgFile, 4))
                    Case ".jpg", ".jpeg", ".bmp", ".png", ".gif", ".tif"
                        imagePath = defaultNewFolder & "\" & imgFile
                        Exit Do
                    Case Else
                        imgFile = Dir()
                End Select
            Loop
        End If
    End If
    
    If imagePath <> "" Then
        Shell "mspaint /pt """ & imagePath & """", vbHide
        MsgBox "تم إرسال الإستمارة للطباعة", vbInformation + vbMsgBoxRight, ""
    Else
        MsgBox "لا توجد استمارة لطباعتها", vbExclamation
    End If
    
    Exit Sub
    
ErrorHandler:
    MsgBox "حدث خطأ", vbCritical + vbMsgBoxRight, ""
End Sub

 

وقد جعلت الكود أولاً يقرأ المجلد New اذا كان بجانب قاعدة البيانات فيأخذ الإستمارة منه ، وإلا فيذهب إلى المسار الذي حددته سابقاً ليطبع لك الصورة المعبرة عن الإستمارة منه .

 

 

Database.accdb

تم تعديل أبريل 4, 2025 بواسطه Foksh
إضافة المرفق

[محمد التميمي]

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

مداخلة سريعة ، هل اسم ملف الإستمارة ثابت ؟؟

السلام عليكم 

اي تسمية بالانكليزي مثلا (ِASD)

[Foksh]

1 دقيقه مضت, محمد التميمي said:

اي تسمية بالانكليزي مثلا (ِASD)

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

اقصد اسم الاستمارة SDN !!!

هل هو ثابت ؟؟؟

[محمد التميمي]

1 دقيقه مضت, Foksh said:

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

اقصد اسم الاستمارة SDN !!!

هل هو ثابت ؟؟؟

ثابت ان شاء الله

[Foksh]

الان, محمد التميمي said:

ثابت ان شاء الله

اذاً هل تريد للكود ان يتم تحديد مسار واسم ملف الاستمارة ؟؟ أم تبقى على هذه الفكرة كما شاركتها سابقاً بحيث ان الكود يقوم بطباعة أول صورة يجدها في المجلد ؟؟؟

[محمد التميمي]

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

اذاً هل تريد للكود ان يتم تحديد مسار واسم ملف الاستمارة ؟؟ أم تبقى على هذه الفكرة كما شاركتها سابقاً بحيث ان الكود يقوم بطباعة أول صورة يجدها في المجلد ؟؟؟

نعم استاذي الفاضل الفكرة هي يتم طباعة صورة الاستمتارة الوحيدة باسم ASD مباشر من خلال زر امر في نموذج والاستمارة موجودة بفولدر (NEW) بجانب قاعدة البيانات

بحسب المرفق الاول في المشاركة

تم تعديل أبريل 4, 2025 بواسطه محمد التميمي

[Foksh]

الان, محمد التميمي said:

نعم استاذي الفاضل الفكرة هي يتم طباعة صورة الاستمتارة الوحيدة باسم ASD مباشر من خلال زر امر في نموذج والاستمارة موجودة بفولدر (NEW) بجانب قاعدة البيانات

توهتني .. اسم الصورة في المرفق ليست ASD كما أشرت . أذاكنت تفضل تحديداسم صورة الاستمارة من خلال الكود فهو سهل ، لكن اذا كانت الصورة وحيدة ولا وجود لملفات أخرى غيرها في المجلد فالكود في المرفق يلبي حاجتك بدون تحديد اسم صورة الاستمارة . والكود ايضاً يدعم حالتين إما المجلد الي بجانب قاعدة البيانات بغض النظر عن مساره أو ذلك الموجود في المسار الذي ذكرته لنا سابقاً في القرص D ... جربه واخبرنا بالنتيجة بعد الطباعة ؟؟؟

[محمد التميمي]

1 دقيقه مضت, Foksh said:

توهتني .. اسم الصورة في المرفق ليست ASD كما أشرت . أذاكنت تفضل تحديداسم صورة الاستمارة من خلال الكود فهو سهل ، لكن اذا كانت الصورة وحيدة ولا وجود لملفات أخرى غيرها في المجلد فالكود في المرفق يلبي حاجتك بدون تحديد اسم صورة الاستمارة . والكود ايضاً يدعم حالتين إما المجلد الي بجانب قاعدة البيانات بغض النظر عن مساره أو ذلك الموجود في المسار الذي ذكرته لنا سابقاً في القرص D ... جربه واخبرنا بالنتيجة بعد الطباعة ؟؟؟

الله لا يتوهك عزيزي الكريم سالتني عن اسم الاستمارة ثابت فقلت لك اسمها ASD ثابت اريد من خلال المسار في D:\CARD\New

[Foksh]

الان, محمد التميمي said:

الله لا يتوهك عزيزي الكريم سالتني عن اسم الاستمارة ثابت فقلت لك اسمها ASD ثابت اريد من خلال المسار في D:\CARD\New

حسناً جرب الملف المرفق وأخبرني بالنتيجة ،، وغير اسمها الى اي اسم تريده  

[محمد التميمي]

الان, Foksh said:

حسناً جرب الملف المرفق وأخبرني بالنتيجة ،، وغير اسمها الى اي اسم تريده  

وين الملف

[Foksh]

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

مداخلة سريعة ، هل اسم ملف الإستمارة ثابت ؟؟

على العموم ، جرب هذه الفكرة أيضاً اشتقاقاً من فكرة المهندس @Eng.Qassim ..

Private Sub Comaand4_Click()
    On Error GoTo ErrorHandler
    
    Dim dbPath As String
    Dim localNewFolder As String
    Dim defaultNewFolder As String
    Dim imagePath As String
    Dim imgFile As String
    
    dbPath = CurrentProject.Path
    
    localNewFolder = dbPath & "\New"
    defaultNewFolder = "D:\CARDS\New"
    
    If Dir(localNewFolder, vbDirectory) <> "" Then
        imgFile = Dir(localNewFolder & "\*.*")
        
        Do While imgFile <> ""
            Select Case LCase(Right(imgFile, 4))
                Case ".jpg", ".jpeg", ".bmp", ".png", ".gif", ".tif"
                    imagePath = localNewFolder & "\" & imgFile
                    Exit Do
                Case Else
                    imgFile = Dir()
            End Select
        Loop
    End If
    
    If imagePath = "" Then
        If Dir(defaultNewFolder, vbDirectory) <> "" Then
            imgFile = Dir(defaultNewFolder & "\*.*")
            
            Do While imgFile <> ""
                Select Case LCase(Right(imgFile, 4))
                    Case ".jpg", ".jpeg", ".bmp", ".png", ".gif", ".tif"
                        imagePath = defaultNewFolder & "\" & imgFile
                        Exit Do
                    Case Else
                        imgFile = Dir()
                End Select
            Loop
        End If
    End If
    
    If imagePath <> "" Then
        Shell "mspaint /pt """ & imagePath & """", vbHide
        MsgBox "تم إرسال الإستمارة للطباعة", vbInformation + vbMsgBoxRight, ""
    Else
        MsgBox "لا توجد استمارة لطباعتها", vbExclamation
    End If
    
    Exit Sub
    
ErrorHandler:
    MsgBox "حدث خطأ", vbCritical + vbMsgBoxRight, ""
End Sub

 

وقد جعلت الكود أولاً يقرأ المجلد New اذا كان بجانب قاعدة البيانات فيأخذ الإستمارة منه ، وإلا فيذهب إلى المسار الذي حددته سابقاً ليطبع لك الصورة المعبرة عن الإستمارة منه .

 

 

Database.accdb 708 kB · 0 downloads

😯

[محمد التميمي]

1 دقيقه مضت, Foksh said:

😯

احسنت تم الطباعة الاستمارة مباشرة لكن بنصف ورقة يعني الاستمارة ظهرت صغيرة

[Foksh]

4 دقائق مضت, محمد التميمي said:

احسنت تم الطباعة الاستمارة مباشرة لكن بنصف ورقة يعني الاستمارة ظهرت صغيرة

 

المشكلة قد تكون بسبب إعدادات الطباعة في Paint ، حيث يقوم البرنامج بطباعة الصورة بحجمها الأصلي دون تكبيرها لتناسب الورقة

[محمد التميمي]

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

المشكلة قد تكون بسبب إعدادات الطباعة في Paint ، حيث يقوم البرنامج بطباعة الصورة بحجمها الأصلي دون تكبيرها لتناسب الورقة

بارك الله بجهودك استاذي الكريم ساعمل على حل مشكلة اعدادات الطابعة المهم الكود يعمل بشكل جيد

شكرا جزيلا.. 

4 ساعات مضت, Eng.Qassim said:

جرب هذه المحاولة

 

CARDS.rar 169.69 kB · 10 downloads

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

شكرا جزيلا

3 دقائق مضت, محمد التميمي said:

بارك الله بجهودك استاذي الكريم ساعمل على حل مشكلة اعدادات الطابعة المهم الكود يعمل بشكل جيد

شكرا جزيلا.. 

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

شكرا جزيلا

اخواني الكرام في رايكم لمن اعطي علامة افضل اجابة اعينوني اعانكم الله

تم تعديل أبريل 4, 2025 بواسطه محمد التميمي

[Eng.Qassim]

السلام عليكم ...انا استخدمت (txtBrows).. على اعتبار ان المجلد يحتوب على اكثر من صورة 

بالنسبة الى مشكلة نصف الصفحة بالتاكيد لديك مشكلة في اعدادات الطباعة 

المثال المرفق يطبع لك جميع الصور في الفولدر 

 

 

CARDS.rar

[Eng.Qassim]

منذ ساعه, محمد التميمي said:

خواني الكرام في رايكم لمن اعطي علامة افضل اجابة اعينوني اعانكم الله

ليس المهم لمن افضل اجابة ...المهم انك استفدت وحللت مسألتك وقد يحتاج لها غيرك