Excel metin listesinden QR Kod oluşturma

Oluşturulan Excel Dashboard ile "30 Adet" 'lik metin listesiyle eşleştirilen alana yazılan ifadeye göre, (Türkçe ifadeler kullanmadan, "hata vermekte") QR barkodlar otomatik olarak oluşmaktadır. Oluşturduğum makro çalışma kitabını, sayfa sonunda paylaştığım linkten indirebilirsiniz. Bu sayfada, sonuca ulaşıncaya kadar kat edilen aşamaların paylaşımı yer almaktadır.

Makroyu ilk çalıştırdığınızda, Default olarak Office deki makro kısıntından dolayı, sarı bantta yer alan "içeriği etkinleştir" butonuna basarak aktif edebilirsiniz.

Sayfa açılışta "auto-open" komutuna bağlanan "Resimleri kaldır" makrosuyla başlamakta ve mevcut resimleri silinmesi sağlanmaktadır. Bu işlemle (Yeni üretilen kod aynı alana üzerine yazdığından, QR üzerine QR binmesiyle okunamayacak duruma gelmesi ve de açılışta resim adresiyle bağlantı kurma hatası edinilen tecrübeyle ortadan kaldırılmıştır)
Komut aşağıdaki gibidir.
auto_open()
For syf = 1 To Sheets.Count
Sheets(syf).Pictures.Delete
Next
End Sub

Metin listesi 30 adetlik hücre olarak hazırlandı. Metin listesinde bulunan ifadeler, "QR Oluştur" sayfasındaki hücrelerle eşitlenerek, bu alandaki bilginin ilgili hücreye yansıması sağlandı.

Tekrar tekrar çalıştırıldığında, limit hatası verebilmekte. Resimleri sil butonuna bastıktan sonra kaydedip kapatılması, birkaç dakika bekledikten sonra QR oluştur butonuna basarak hatasız oluşturulabilir.

"QR Oluştur" butonuna bağlanan makro kodu aşağıdaki gibidir. "A1" hücresinde iken başlatıp aynı hücreye dönerek bitirilmekte. İlk hücre "C6" üzerine kod karşılığı resmi yapıştırmasını, aşağıdaki link adresi üzerinden "data= " &" ifadesinden sonra sayfa adı ve metin bilgisinin olduğu hücre belirtilmekte. Sonrasında hücre içinde, "35 ve 8" değerlerinin olduğu satırlarda "QR" resminin hücrenin solundan uzaklık ve hücre alt kenarından uzaklık değeridir (deneme yanılma ile ortalandı) aynı kodları alt alta 30 defa yapıştırılıp, resimlerin yapıştırılacağı ve metin bilgini alacağı hücre adlarının girilmesi ile oluşan kod, "QR Oluştur" butonuna bağlanması ile işlem gerçekleşmektedir.

Range("A1").Select
Sheets("QR Oluştur").Select Range("C6").Select
ActiveSheet.Pictures.Insert( _
"https://barcode.tec-it.com/barcode.ashx?data= " & Sheets("QR Metin Listesi").Range("C5").Value & " &code=QRCode&eclevel=L&download=true&_gl=1*5y14k0*_ga*MTgyMDA0ODU5MC4xNjU0MDc2NDIz*_up*MQ.." _
).Select
Selection.ShapeRange.IncrementLeft 35
Selection.ShapeRange.IncrementTop 8
Application.CutCopyMode = False
Range("A1").Select

Metin listesine, ürünlerin model veya içerebileceği kod yapısına göre barkod oluşturabilir, TC bilgi, Mobil telefon veya demirbaş ürünlerin barkod yapısını oluşturur veya ihtiyaca göre kullanabilirsiniz.

Kod oluşturmadan önce, Seçilen hücre "A1" olmalı. (Arada da olsa, hata alınması bu sebepten)

Yeni metin listesine göre barkod yapısının oluşumu görülmektedir.

Birçok QR kod oluşturan adres var ama bağlantı kopyalamaya izin vermiyor. Barkodları oluşturduğum adres aşağıdaki adrestir. https://barcode.tec-it.com/en/QRCode?data=This%20is%20a%20QR%20Code%20by%20TEC-IT

"2D QR Code" alanı seçiliyken, data kısmına ilgili metni yazıp "refresh" linkine tıklayarak kodun oluşmasını sağlayıp, "Download" butonuna sağ klik, "bağlantı adresini kopyala" ile adresini alıyorum.

Her barkod ihtiyacımda tek tek bunu yapmamak için, aşağıdaki adresi incelerseniz, kalın punto ile yazdığım metin yerine yazacağınız kelime ile oluşan link adresini, browser sayfasına yazdığınızda, bilgisayarınıza oluşan kod gif formatında otomatik inmektedir.

https://barcode.tec-it.com/barcode.ashx?data=https%3A%2F%2Fmuhammedyusufolgun.blogspot.com&code=QRCode&translate-esc=true&eclevel=L&download=true

Yukarıdaki işlemde, sayfaya yönlendirmiştim. Aşağıda aynı sayfada, ilgili hücreye yönlendirilmiş hali görülmektedir. ("B2" resmi yapıştıracağı, "C2" metni alacağı hücre.) Bu alanları duruma göre değiştirebilirsiniz.

Range("A1").Select
    Selection.Copy
    Range("B2").Select
    ActiveSheet.Pictures.Insert( _
        "https://barcode.tec-it.com/barcode.ashx?data= " & Range("C2").Value & " &code=QRCode&eclevel=L&download=true&_gl=1*5y14k0*_ga*MTgyMDA0ODU5MC4xNjU0MDc2NDIz*_up*MQ.." _
        ).Select

Selection.ShapeRange.IncrementLeft 35
Selection.ShapeRange.IncrementTop 8

        Application.CutCopyMode = False

Yazdırma Görünüm ve Ayarları: 
Oluşturulan makro çalışması, Google drive adresinde paylaşılmaktadır. İndirmek için Tıklayınız.