⭐ هدية ~ QR ملون بطريقة جديدة بدون إكسل - 2025⭐

[Foksh]

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء )

 

كثير منا يبحث عن QR ( رمز إستجابة سريعة ) ولكن ملوّن !! ونستطيع التحكم باللون حسب حاجته !!

اليوم بطريقة بسيطة يتم تنفيذها بكل سلاسة سنحقق ذلك . والفائدة على سبيل المثال :-

           الإبتعاد عن النمط التقليدي اللون الأسود المعروف به رمز الـ QR  ..

           شكل جمالي ملفت لرمز الإستجابة QR ..

           التمييز بين الأقسام أو الأستخدام للـ QR حسب حاجة المشروع . فمثلاً ( قسم المحاسبة لهم رمز باللون الأزرق ، قسم الصيانة لهم رمز باللون الأسود ، المعلمين رمز باللون الأحمر ..... إلخ . والكثير من الإستخدامات التي لا تخطر ببالي حالياً .

 

 

 تأكد من تثبيت إصدار NET Framework 4.0 أو أعلى على جهازك . تستطيع التحميل من هذا الرابط ، أو بشكل مباشر من هذا الرابط .

 برنامج ImageMagick . ويمكنك تحميله من رابط الموقع من هذا الرابط ، أو بشكل مباشر من هذا الرابط .

 ملفات الـ DLL ( zxing.interop.dll ، zxing.dll ، zxing.interop.tlb ) والتي هي مكتبات سيتم إضافتها الى محرر الأكواد VBA في آكسيس لاحقاً طريقة التثبيت والإضافة ( موجودة في الملف المرفق ) .

 

 

 أولا يلزمنا تسجيل المكتبات المستخدمة في المشروع ( وهنا سنستخدم ZXing لتنفيذ مهمتنا ) وطبعاً سنحتاج مكتبة QRCode ، ويجب تسجيلها ليتم إضافتها في آكسيس في مكتبات الـ VBA > Tools > References . فكيف ننفذ هذه الخطوة المهمة . بعد التأكد من تثبيت المستلزمين السابقين :-

1. افتح موجه الأوامر CMD كمسؤول ( Run as Administrator ) .
2. قم بكتابة السطر التالي لتسجيل المكتبة :-
    

   cd C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library
   
   ---------------------
   حيث هنا ، المسار
   C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library
    
   Dll مسار المجلد الذي يحتوي ملفات الـ
   
   التي تحدثنا عنها من ضمن المستلزمات ، وسيكون متغيراً حسب جهازك

    

3. قم بكتابة السطر التالي :-

   C:\Windows\Microsoft.NET\Framework64\v4.0.30319\regasm.exe /codebase zxing.interop.dll

4. ومن المفترض أن تظهر معك النتيجة بهذا الشكل :-
   
   
   
   أما خلاف ذلك فأن عملية تسجيل المكتبة لم تنجح ولن يتم إضافتها إلى محرر الأكواد VBA كما نريد .
    
5. الآن لاستكمال عملية تسجيل المكتبة وإضافتها الى محرر الأكواد VBA ، نطبق آخر خطوة وهي :-

   C:\Windows\Microsoft.NET\Framework64\v4.0.30319\regasm.exe /codebase "C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library\zxing.interop.dll" /tlb:"C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library\zxing.interop.tlb"
   
   ---------------------
   حيث هنا ، المسار
   C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library\
    
   Dll مسار المجلد الذي يحتوي ملفات الـ
   
   التي تحدثنا عنها من ضمن المستلزمات ، وسيكون متغيراً حسب جهازك

6. الآن نفتح قاعدة بيانات جديدة ، ونذهب إلى محرر الأكواد ( Tools > References ) ، ونبحث عن المكتبة التالية كما في الصورة :-
   
    

 الآن وبعد إتمام عملية التسجيل للمكتبة المطلوبة وتثبيت المستلزمات السابقة ، نقوم بإنشاء نموذج يحتوي على مربع نص ، وعنصر صورة ، و زر لتنفيذ العملية .

ثم نأتي إلى الأكواد ، وما سنحتاجه الآن هو مديول يحتوي على الدالتين التاليتين :-

'**********************************************
'***                                        ***
'***   FFFFFF   OOO   KK KK    SSSS  HH  HH ***
'***   FF      O   O  KK KK   SS     HH  HH ***
'***   FFFFF   O   O  KKK      SS    HHHHHH ***
'***   FF      O   O  KK KK     SS   HH  HH ***
'***   FF       OOO   KK  KK  SSSSS  HH  HH ***
'***                                        ***
'**********************************************

Option Compare Database
Option Explicit

#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Function Encode_To_QR_Code_To_File(str As String, Optional foregroundColor As String = "black", Optional backgroundColor As String = "white") As String
    On Error GoTo ErrorHandler
    Dim writer As IBarcodeWriter
    Dim qrCodeOptions As QrCodeEncodingOptions
    Dim filepath As String
    Dim folderPath As String
    folderPath = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & "QRImage"
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
    filepath = folderPath & "\QRCode_" & Format(Now, "yyyyMMdd_hhmmss") & ".png"
    Set qrCodeOptions = New QrCodeEncodingOptions
    Set writer = New BarcodeWriter
    writer.Format = BarcodeFormat_QR_CODE
    Set writer.Options = qrCodeOptions
    qrCodeOptions.Height = 200
    qrCodeOptions.Width = 200
    qrCodeOptions.CharacterSet = "UTF-8"
    qrCodeOptions.Margin = 1
    qrCodeOptions.ErrorCorrection = ErrorCorrectionLevel_H
    writer.WriteToFile str, filepath, ImageFileFormat_Png
    If Change_QR_Code_Colors_ImageMagick(filepath, foregroundColor, backgroundColor) Then
        Encode_To_QR_Code_To_File = filepath
    Else
        Encode_To_QR_Code_To_File = ""
    End If
    Exit Function
ErrorHandler:
    Encode_To_QR_Code_To_File = ""
    MsgBox "حدث خطأ أثناء إنشاء QR Code: " & Err.Description, vbCritical, "خطأ"
End Function

Function Change_QR_Code_Colors_ImageMagick(filepath As String, foregroundColor As String, backgroundColor As String) As Boolean
    On Error GoTo ErrorHandler
    Dim batchFilePath As String
    Dim batchContent As String
    Dim result As Long
    If Dir(filepath) = "" Then
        MsgBox "لم يتم العثور على الملف: " & filepath, vbCritical, "خطأ"
        Exit Function
    End If
    batchContent = "@echo off" & vbCrLf & "magick " & Chr(34) & filepath & Chr(34) & " -fill " & foregroundColor & " -opaque black -fill " & backgroundColor & " -opaque white " & Chr(34) & filepath & Chr(34)
    batchFilePath = Environ$("temp") & "\ChangeQRColors.bat"
    Open batchFilePath For Output As #1
    Print #1, batchContent
    Close #1
    result = Shell("powershell -Command Start-Process " & Chr(34) & batchFilePath & Chr(34) & " -Verb RunAs", vbHide)
    DoEvents
    Sleep 3000
    If Dir(filepath) <> "" Then
        Change_QR_Code_Colors_ImageMagick = True
    Else
        Change_QR_Code_Colors_ImageMagick = False
    End If
    Kill batchFilePath
    Exit Function
ErrorHandler:
    Change_QR_Code_Colors_ImageMagick = False
    MsgBox "حدث خطأ أثناء تغيير ألوان QR Code: " & Err.Description, vbCritical, "خطأ"
End Function

 

 وفي حدث عند النقر لزر التنفيذ ، الكود التالي :-

Private Sub Command20_Click()
    Dim imagePath As String
    Dim folderPath As String

    If IsNull(Me.Text0) Or Me.Text0 = "" Then
        MsgBox "QR Code الرجاء إدخال نص لإنشاء", vbExclamation, ""
        Exit Sub
    End If

    Dim foregroundColor As String
    Dim backgroundColor As String
    foregroundColor = "Blue"
    backgroundColor = "white"

    imagePath = Encode_To_QR_Code_To_File(Me.Text0, foregroundColor, backgroundColor)
    
    If imagePath <> "" Then
        Me.Image0.Picture = imagePath
        MsgBox "  بنجاح QR Code تم إنشاء", vbInformation, ""
        folderPath = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & "QRImage"
    Else
        MsgBox "فشل في إنشاء QR Code", vbCritical, ""
    End If
End Sub

 

الآن لتغيير ألوان الـ QR كخلفية أو لون الرمز نفسه ، تستطيع التعديل من خلال السطرين التاليين في زر التنفيذ :-

    foregroundColor = "Blue" <---- هنا لون الرمز نفسه
    backgroundColor = "white" <---- هنا لون الخلفية

 

وهنا نكون قد وضحنا المطلوب وطريقة تنفيذه خطوة بخطوة .. 

 

 

QrCodeZXing.zip