💥 التحدي 3 : ونعم ، يمكنك الاستعانة بالذكاء الاصطناعي لعمل الباركود Code128 و QR

[Foksh]

5 ساعات مضت, منتصر الانسي said:

لو كان بإمكان الأخ @Foksh إضافة هذه الخيارات كمعلمة لإختيار أحدها وتنفيذ الأمر مباشرة سيكون أفضل

تفضل اخي منتصر .. التعديلات التي تمت :-

• الدالة DrawAndSaveBarcode أصبحت :-

Public Sub DrawAndSaveBarcode(txt As TextBox, img As Image, barcodeType As String, Optional bVertical As Boolean = False)
    Dim saveDir As String
    Dim fullPath As String
    Dim parentReport As Report
    Dim saveMode As String
    Dim shouldSave As Boolean

    On Error Resume Next
    Set parentReport = img.Parent
    If parentReport Is Nothing Then Set parentReport = img.Parent.Parent
    On Error GoTo 0

    saveMode = "NoSave"
    If Not parentReport Is Nothing Then
        saveMode = Nz(parentReport.OpenArgs, "NoSave")
    End If

    shouldSave = False
    If saveMode = "SaveAll" Or saveMode = "SavePage" Then
        shouldSave = True
    End If

    If shouldSave Then
        saveDir = CurrentProject.Path & "\QRImg\"
        If Dir(saveDir, vbDirectory) = "" Then MkDir saveDir
        fullPath = saveDir & barcodeType & "_" & txt.Value & ".bmp"
    Else
        fullPath = ""
    End If

    If LCase(barcodeType) = "qr" Then
        Call drawQuickResponseToImage(txt, img, savePath:=fullPath)
    ElseIf LCase(barcodeType) = "code128" Then
        Call drawCode128(txt, img, , bVertical, savePath:=fullPath)
    End If
End Sub

• الإستدعاءات في الأزرار أصبحت :-

 

Private Sub cmdOpenWNavSave_Click()
    DoCmd.OpenReport "rpt_BG_img_Barcode", acViewPreview, , , , "SavePage"
End Sub

Private Sub cmdOpenWOSave_Click()
    DoCmd.OpenReport "rpt_BG_img_Barcode", acViewPreview, , , , "NoSave"
End Sub

Private Sub cmdOpenWSave_Click()
    DoCmd.OpenReport "rpt_BG_img_Barcode", acViewPreview, , , , "SaveAll"
End Sub

Private Sub cmdSave_Click()
    DoCmd.OpenReport "rpt_BG_img_Barcode", acViewPreview, , , acHidden, "SaveAll"
    DoCmd.Close acReport, "rpt_BG_img_Barcode", acSaveNo
    MsgBox "بنجاح QRImg تم توليد وحفظ جميع الصور في مجلد", vbInformation + vbMsgBoxRight, ""
End Sub

• وفي التقرير أصبحت التمرير كالآتي :-

Private Sub Report_Open(Cancel As Integer)
    On Error Resume Next
    If Nz(Me.OpenArgs, "") = "SaveAll" Then
        Me.TxtPages.ControlSource = "=[Pages]"
    Else
        Me.TxtPages.ControlSource = ""
    End If
    On Error GoTo 0
End Sub

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
    Call DrawAndSaveBarcode(Me.FieldCode128, Me.ImgQR4, "Code128")
    Call DrawAndSaveBarcode(Me.FieldCode128, Me.ImgQR5, "Code128", True)
    Call DrawAndSaveBarcode(Me.FieldQRCode, Me.ImgQR2, "QR")
End Sub

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

 

 

 

QR_Barcode - 5.accdb