- Katılım
- 1 Aralık 2007
- Mesajlar
- 665
- Excel Vers. ve Dili
- Office 2003 excel Türkçe
Merhaba Arkadaşlar,
Konu ile ilgili deneme amaçlı VS2022 ve VBNET de hazırladığım küçük programı sizlerle paylaşmak istiyorum.
Herhangi bir Excel dosyasını açtığınızda, A sütununun 2, 3 ve 4. satırındaki hücrelerde bulunan verileri tire (-) işareti ile birleştirip QR koda çeviriyorum. Oluşan QR kodu bir resim dosyası olarak kaydediyorum. Ayrıca istenirse, “Yazdır” butonu ile yazdırma işlemi de yapılabiliyor.
Kodları da ayrıca sizlerle paylaşacağım.
Konu ile ilgili deneme amaçlı VS2022 ve VBNET de hazırladığım küçük programı sizlerle paylaşmak istiyorum.
Herhangi bir Excel dosyasını açtığınızda, A sütununun 2, 3 ve 4. satırındaki hücrelerde bulunan verileri tire (-) işareti ile birleştirip QR koda çeviriyorum. Oluşan QR kodu bir resim dosyası olarak kaydediyorum. Ayrıca istenirse, “Yazdır” butonu ile yazdırma işlemi de yapılabiliyor.
Kodları da ayrıca sizlerle paylaşacağım.
Imports Microsoft.Office.Interop.Excel
Imports QRCoder
Imports System.IO
Imports System.Drawing.Printing
Public Class Form1
' Sınıf seviyesinde tanımlanmalı (formun üst kısmına ekleyin)
Private WithEvents qrPrinter As New PrintDocument
Private qrImageToPrint As Image
Private Sub btnQRCodeOlustur_Click(sender As Object, e As EventArgs) Handles btnQRCodeOlustur.Click
' Dosya seçme iletişim kutusunu aç
Dim openFileDialog As New OpenFileDialog()
openFileDialog.Filter = "Excel Dosyaları|*.xlsx;*.xls"
openFileDialog.Title = "Excel Dosyası Seçin"
If openFileDialog.ShowDialog() <> DialogResult.OK Then
MessageBox.Show("Dosya seçilmedi.")
Exit Sub
End If
Dim excelFilePath As String = openFileDialog.FileName
' Excel uygulamasını başlatma
Dim excelApp As New Application()
Dim workbook As Workbook = Nothing
Dim worksheet As Worksheet = Nothing
Try
' Excel dosyasını aç
workbook = excelApp.Workbooks.Open(excelFilePath)
worksheet = CType(workbook.Sheets(1), Worksheet)
' Hücrelerden veri oku
Dim veri1 As String = CType(worksheet.Cells(2, 1), Range).Value.ToString()
Dim veri2 As String = CType(worksheet.Cells(3, 1), Range).Value.ToString()
Dim veri3 As String = CType(worksheet.Cells(4, 1), Range).Value.ToString()
' Verileri birleştir
Dim birlesikVeri As String = veri1 & "-" & veri2 & "-" & veri3
' QR kod oluştur
Dim qrGenerator As New QRCodeGenerator()
Dim qrData = qrGenerator.CreateQrCode(birlesikVeri, QRCodeGenerator.ECCLevel.Q, False, False, QRCodeGenerator.EciMode.Utf8)
Dim qrCode As New QRCode(qrData)
' QR kod görüntüsünü oluştur
Dim qrCodeImage As Bitmap = qrCode.GetGraphic(20)
PictureBox1.Image = qrCodeImage
' PNG olarak kaydet
Dim savePath As String = Path.Combine(Path.GetDirectoryName(excelFilePath), "qrcode.png")
qrCodeImage.Save(savePath)
MessageBox.Show("QR kod başarıyla oluşturuldu ve '" & savePath & "' konumuna kaydedildi!")
Catch ex As Exception
MessageBox.Show("Hata oluştu: " & ex.Message)
Finally
If workbook IsNot Nothing Then workbook.Close(False)
If excelApp IsNot Nothing Then excelApp.Quit()
ReleaseObject(worksheet)
ReleaseObject(workbook)
ReleaseObject(excelApp)
End Try
End Sub
Private Sub btnYazdir_Click(sender As Object, e As EventArgs) Handles btnYazdir.Click
If PictureBox1.Image Is Nothing Then
MessageBox.Show("Yazdırılacak QR kod bulunamadı.", "Uyarı", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Exit Sub
End If
qrImageToPrint = PictureBox1.Image
Dim yazdirDialog As New PrintDialog()
yazdirDialog.Document = qrPrinter
If yazdirDialog.ShowDialog() = DialogResult.OK Then
qrPrinter.Print()
End If
End Sub
Private Sub qrPrinter_PrintPage(sender As Object, e As PrintPageEventArgs) Handles qrPrinter.PrintPage
' Yazdırılacak QR kodun boyutu (20mm x 20mm ≈ 75 x 75 piksel)
Dim qrWidth As Integer = 75
Dim qrHeight As Integer = 75
' QR kodu sayfa ortasına konumlandır (isteğe bağlı)
Dim leftMargin As Integer = (e.PageBounds.Width - qrWidth) \ 2
Dim topMargin As Integer = (e.PageBounds.Height - qrHeight) \ 2
' QR kodunu belirtilen boyut ve konumda çiz
e.Graphics.DrawImage(qrImageToPrint, leftMargin, topMargin, qrWidth, qrHeight)
End Sub
Private Sub ReleaseObject(ByVal obj As Object)
Try
If obj IsNot Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
End If
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
