Acc Daralmehrab

لا

السلام عليكم ورحمة الله وبركاته كنت احتاج إضافة QR للفاتورة طبقا لطلبات الفاتورة الالكترونية لهيئة الزكاة والدخل السعودية وبالبحث وجدت هذا الكود المرفق على اليويتوب وهو كود لاصدار ال QR ويعمل معي جيدا ويمكن قراءته عن طريق كاميرا الجوال لكن هيئة الزكاة والدخل السعودية طلبت إصدار الQR بنظام آخر أعتقد Hexadecimal encode 64, tag-len-value لا تسطيع كاميرا الجوال قراءته ولكن يقرأ عن طريق تطبيق آخر مخصوص هو E-InvoiceQR Reader KSA أرجوا ممن لديه الخبرة مساعدتي في عمل هذا الكود Sub GenerateSingleQRCode() Dim QRPic As String, QRURL As String, QRData As String, ForeCol As String, BackCol As String Dim QRSize As Long, x As Long With Sheet2 x = .Range("D" & Rows.Count).End(xlUp).Row + 1 On Error Resume Next .Shapes("QRItemPic").Delete On Error GoTo 0 QRData = .Range("G21").Value 'Item Name (QR Data) QRSize = Sheet3.Range("C5").Value 'Large CQR Size ForeCol = Right("00000" & Hex(Sheet3.Range("C4").Value), 6) ForeCol = Right(ForeCol, 2) & Mid(ForeCol, 3, 2) & Left(ForeCol, 2) BackCol = Right("00000" & Hex(Sheet3.Range("C3").Value), 6) BackCol = Right(BackCol, 2) & Mid(BackCol, 3, 2) & Left(BackCol, 2) QRURL = "https://api.qrserver.com/v1/create-qr-code/?data=" & QRData & "&size=" & QRSize & "x" & QRSize & _ "&charset-source=UTF-8&charset-target-=UTF-9ecc=L&color=" & ForeCol & "&bgcolor=" & BackCol & _ "&margin=0&qzone=1&format=png" With Sheet2.Pictures.Insert(QRURL) .Name = "QRItemPic" .Left = Sheet2.Range("A21:D21").Left + (Sheet2.Range("A21:D21").Width - .Width) / 2 .Top = Sheet2.Range("A" & x).Top + 5 End With End With End Sub