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

**Foksh** · يناير 8, 2025

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

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

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

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

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

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

Qr_Opt.png.988ca817480a5bcead8ac46cd4132415.png

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

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

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

QR_Opt1.png.330fba4f9c9a9e29d2195c1f4cb0b961.png

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

افتح موجه الأوامر CMD كمسؤول ( Run as Administrator ) .

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

cd C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library

---------------------
حيث هنا ، المسار
C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library
 
Dll مسار المجلد الذي يحتوي ملفات الـ

التي تحدثنا عنها من ضمن المستلزمات ، وسيكون متغيراً حسب جهازك

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

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

ومن المفترض أن تظهر معك النتيجة بهذا الشكل :-

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

الآن لاستكمال عملية تسجيل المكتبة وإضافتها الى محرر الأكواد 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 مسار المجلد الذي يحتوي ملفات الـ

التي تحدثنا عنها من ضمن المستلزمات ، وسيكون متغيراً حسب جهازك

الآن نفتح قاعدة بيانات جديدة ، ونذهب إلى محرر الأكواد ( 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" <---- هنا لون الخلفية

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

QR_Opt2.png.bf8a24c31a8f623014b536cb505c058d.png

QrCodeZXing.zip

Thanks.png.002aec0e4949dabeb2bfbe2763fce0ec.png

**ابو جودي** · يناير 14, 2025

ومشاركة مع استاذى واخى الحبيب الاستاذ @Foksh :fff:

طريقتى المتواضعة

zint barcode generator V2.zip

**Moosak** · يناير 15, 2025

تسلم الأيادي مستر @Foksh 😊🌼🌹🌷

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

طريقتى المتواضعة

لااااااااااا ... ذي محتاجة شرح لحالها 😎🖐

**ابو جودي** · يناير 15, 2025

ابشــــــر

ولكن الشرح اجمالا وتفصيلا تجده فى الموضوعات التالية

انا فقط كل ما قمت به هو اضفاء اكبر قدر ممكن من المرونة فى كتابة الاكواد والتعامل معها

لكن كل الفضل بعد رب العزة سبحانه وتعالى يرجع الى طرح استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr

صاحب السبق فى هذه الافكار والموضوع وطرحه وشرحه اجمالا وتفصيلا

**ابو جودي** · يناير 15, 2025

وفى هذا الرابط شرح الـ Command Line الخاص بالاداة المستخدمه من الموقع الرسمى لها

https://zint.org.uk/manual/chapter/4

أستبرق الموسوي · فبراير 1, 2025

وفقكم الله لكل خير

at_aziz · يناير 18

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

عندي مشكله في قراءة الكيو ار عن طريق الكميرا في اجهزة الايفون

احيانا يظهر بس رقم الجوال فقط

وفي بعض التعديلات ينقل النص الى المتصفح السفاري

اما على الاندرويد القراءه جيده وتظهر في ناذه مستقله

جربت كل امثله الكيور اللي عمله الاخ اباجودي في المشاركة الثانيه وكذلك اللي في مشاركة الاخ Foksh

الاساسية

هل هناك حل لهذه المشكله

افيدونا بارك الله فيكم وجزاكم الله خير

**Foksh** · يناير 18

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

السبب طريقة ترميز الـ QR نفسه + سياسة iOS في التعامل معه . و طبعاً كاميرا الآيفون ذكية أكثر من اللازم :biggrin: .

at_aziz · يناير 19

بارك الله فيك وجزاك الله خير اخي الفاضل

هل هناك طريقه تجعل الكيو ار qr

تتم قراءه بشكل جميل على الايفون

**jjafferr** · يناير 19

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

هل هناك طريقه تجعل الكيو ار qr

تتم قراءه بشكل جميل على الايفون

السلام عليكم

بعض الاجهزة لا تقرأ الـ QR العربي (مو عربي فقط ، وانما ما يقرأ Unicode ، ما يقرأ اي لغة غير الانجليزي/اللاتيني) ، ولا يمكن تعديل هذا الشيء في الجهاز!!

فاذا طلبك عمل QR انجليزي فقط ، فتأكد من عدم استخدام الامر eci=24 عند عمل QR :

.

Debug Ace · يناير 20

في 19‏/1‏/2026 at 17:21, at_aziz said:

بارك الله فيك وجزاك الله خير اخي الفاضل

هل هناك طريقه تجعل الكيو ار qr

تتم قراءه بشكل جميل على الايفون

جرب التعديل اللى هنا ورد على لانى لا املك اى فون للتجربة :biggrin:

او يمكنك ارسال هاتف ايفون لى لاقوم بانهاء العمل والتجربة :yes:

يمكنك تحميل الملف من هنا نظرا لقيود الموقع على احجام الملفات

فى حالة التأكد من نجاح عمل قاعدة البيانات وقراءة البيانات بشكل صحيح من خلال كاميرا الايفون
* يرجى من السادة الافاضل المشرفون رفع قاعدة البيانات على المنتدى بشكل مباشر بدلا من استخدام روابط ومواقع رفع مجانية خارجية وشكرا

تم تعديل يناير 20 بواسطه Debug Ace

at_aziz · يناير 21

في 20‏/1‏/2026 at 18:43, Debug Ace said:

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

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

يمكنك تحميل الملف من هنا نظرا لقيود الموقع على احجام الملفات

بارك الله فيك وجزاك الله خير

والله ياليت عندي ايفون كان ارسلته لك للاسف جهازي جالكسي

اخي هذا المال جربته من قبل وهو يفتح البيانات عن طريف اضافة جهة اتصال

من الاشياء اللي مرت علي اذا كان رقم الجوال موجود مسبقا تظهر رساله تفيد الدمج

والمشكله الحقول اللي فيه الزاميه لابد من تعبتها كثيره فيه

ونحن نريد فقط في الكيور ار

الاسم

والسجل

ورقم الجوال

والتاريخ

Debug Ace · يناير 22

14 ساعات مضت, at_aziz said:

بارك الله فيك وجزاك الله خير

والله ياليت عندي ايفون كان ارسلته لك للاسف جهازي جالكسي

اخي هذا المال جربته من قبل وهو يفتح البيانات عن طريف اضافة جهة اتصال

من الاشياء اللي مرت علي اذا كان رقم الجوال موجود مسبقا تظهر رساله تفيد الدمج

والمشكله الحقول اللي فيه الزاميه لابد من تعبتها كثيره فيه

ونحن نريد فقط في الكيور ار

الاسم

والسجل

ورقم الجوال

والتاريخ

هو انت مش كلامك كان ان فى مشكلة عند قراءة بيانات الكيو ار كود من كاميرا الايفون ؟

هو الكلام بيتغير ليه ؟

مش ده كلامك برضو

في 18‏/1‏/2026 at 20:54, at_aziz said:

عندي مشكله في قراءة الكيو ار عن طريق الكميرا في اجهزة الايفون

احيانا يظهر بس رقم الجوال فقط

وفي بعض التعديلات ينقل النص الى المتصفح السفاري

اما على الاندرويد القراءه جيده وتظهر في ناذه مستقله

جربت كل امثله الكيور اللي عمله الاخ اباجودي في المشاركة الثانيه وكذلك اللي في مشاركة الاخ Foksh

الاساسية

هل هناك حل لهذه المشكله

وده كمان

في 19‏/1‏/2026 at 17:21, at_aziz said:

ل هناك طريقه تجعل الكيو ار qr

تتم قراءه بشكل جميل على الايفون

سبحانك اللهم

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

**jjafferr** · يناير 22

23 ساعات مضت, at_aziz said:

والمشكله الحقول اللي فيه الزاميه لابد من تعبتها كثيره فيه

ونحن نريد فقط في الكيور ار

الاسم

والسجل

ورقم الجوال

والتاريخ

هذا اذا استعملت الكود كاملا !!

رجاء انظر الى الرابط الذي وضعته في مشاركتي الاولى ، وهذا كود عمل Vcard الموجود هناك ، ولكني استعملت حقول الاسم الاول ومكان العمل ورقم الهاتف وتاريخ الميلاد فقط ، واوفقت الباقي (بهذه الطريقة انت اختار الحقل اللي تريدها) :

Function Add_Items()

    Dim VCard_Text As String
    
    'clear field
    VCard_Text = ""
        
    VCard_Text = "BEGIN:VCARD" & vbCrLf
    VCard_Text = VCard_Text & "VERSION:3.0" & vbCrLf
'    VCard_Text = VCard_Text & "N:" & Me.[Family Name] & ";" & Me.[Given Name] & ";" & Me.[Additional Name] & ";" & Me.[Name Prefix] & ";" & vbCrLf
    VCard_Text = VCard_Text & "FN:" & Me![Name] & vbCrLf
    VCard_Text = VCard_Text & "ORG:" & Me.[Organization 1] & vbCrLf
    VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 1 - Type] & ",VOICE:" & Me.[Phone 1 - Value] & vbCrLf
'    VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 2 - Type] & ",VOICE:" & Me.[Phone 2 - Value] & vbCrLf
'    VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 3 - Type] & ",VOICE:" & Me.[Phone 3 - Value] & vbCrLf
'    VCard_Text = VCard_Text & "ADR;:" & ";;" & Me.[Address 1] & ";;;;" & vbCrLf
    VCard_Text = VCard_Text & "BDAY:" & Me.[Birthday] & vbCrLf
'    VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 1 - Type] & ":" & Me.[E-mail 1 - Value] & vbCrLf
'    VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 2 - Type] & ":" & Me.[E-mail 2 - Value] & vbCrLf
'    VCard_Text = VCard_Text & "NOTE:" & Me.Notes & vbCrLf
'    VCard_Text = VCard_Text & "URL:" & Me.[Website 1] & vbCrLf
    VCard_Text = VCard_Text & "END:VCARD"
    
    Add_Items = VCard_Text


End Function

at_aziz · يناير 23

بارك الله فيك وجزاك الله خير استاذي الغالي جعفر

تم تعديل الكود كماذكرت

الف شكر لك استاذي ولجميع الاخوه🌹🌹

**jjafferr** · يناير 23

حياك الله

تسجيل الدخول

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

الردود الموصى بها

Foksh

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

ابو جودي

Moosak

ابو جودي

ابو جودي

أستبرق الموسوي

at_aziz

Foksh

at_aziz

jjafferr

Debug Ace

at_aziz

Debug Ace

jjafferr

at_aziz

jjafferr

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

انشئ حساب جديد

تسجيل دخول

محتوي مشابه

مكتبة الموقع - تشفير بيانات في رمز شريطي أو رمز الاستجابة السريعة barcode or Qr-Code

تشفير بيانات في رمز شريطي أو رمز الاستجابة السريعة barcode or Qr-Code

انشاء وطباعة رمز QR يحمل قيم متعددة

جعل الباركود QR يضيف بياناته الى مربعات نص متعددة

qrcode barcode طلب مساعدة : بطاقات او كارنيهات باستخدام باركود

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information