Qr kod

[gokhanbek]

MERHABA
http://qr.zeemind.com/?hl=tr ADRESTE QR KOD BULUNMAKTADIR.

A1 HÜCRESİNE YAZDIĞIM DEĞERİ. İMAGE OLARAK GÖRÜNTÜLEMEK MÜMKÜNMÜ?

 

[serqet]

şuradaki kontrolü yükleyin gerisi kolay.

http://strokescribe.com/en/create-barcode-excel-2007-activex.html

 

[gokhanbek]

birde bunu deneyin belki bu işinizi görürü

 

[gokhanbek]

kolay gelsin

buda döngülü

 

[endexci]

Karekod oluşturma (QR kod)

buda döngülü

Merhaba değerli arkadaşlar

Gökhan beyin paylaşmış olduğu exceli kendime göre uyarladım fakat bazı noktalarda takıldım konu ile ilgili yardımcı olacak arkadaşların desteklerini bekliyorum şimdiden teşekkür ederim.

Karekod oluştur butonuna basılınca üst üste 3 adet kod oluşturuyor tek olması gerekiyor
Karekod oluştuğu zaman küçük oluşturuyor C2 sutununda 3 satır olarak oluşması gerekiyor

 

[Asri]

Alternatif;

http://www.excel.web.tr/f52/excel-qr-code-kare-kod-barkod-retici-programy-t162953.html

 

[endexci]

QR Kodu oluşturma

Alternatif;

http://www.excel.web.tr/f52/excel-qr-code-kare-kod-barkod-retici-programy-t162953.html

Asri bey linkteki çalışmayı inceledim gerçekten harika bir çalışma, benim istediğim konu ile ilgili yardımcı olabilir misiniz

 

[Asri]

Asri bey linkteki çalışmayı inceledim gerçekten harika bir çalışma, benim istediğim konu ile ilgili yardımcı olabilir misiniz

Module1 deki kodu aşağıdaki şekilde değiştiriniz.
Ekle ve Sil prosedürlerini butonlara atayınız

Option Explicit

Sub ekle()
  Dim sPicture As String, pic As Picture
  Dim yazi
  Dim i
  Dim son As Long
  Dim gecici As String

  son = Cells(Rows.Count, "A").End(3).Row
  For i = 2 To son
    yazi = Range("D" & i).Value
    gecici = Replace(yazi, " ", "")
    If gecici <> "" Then
       Range("C" & i).Select
       Set pic = ActiveSheet.Pictures.Insert("https://chart.googleapis.com/chart?chs=300x300&cht=qr&chl=" & yazi)

       With pic
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = ActiveCell.MergeArea.Height
        .Width = ActiveCell.MergeArea.Width
        .Top = ActiveCell.Top
        .Left = ActiveCell.Left
        .Placement = xlMoveAndSize
      End With
    End If
   Next i
End Sub


Sub sil()
  Dim sTemp As String
  Dim sShape As Shape
  Dim MyRange As Range
  Dim son As Long
  
  son = Cells(Rows.Count, "A").End(3).Row
  Set MyRange = Range("C1:C" & son)
  On Error Resume Next
  For Each sShape In ActiveSheet.Shapes
      If sShape.Type <> 8 And sShape.Type <> 12 Then
         sShape.Delete
      End If
  Next
End Sub

 

[endexci]

Module1 deki kodu aşağıdaki şekilde değiştiriniz.
Ekle ve Sil prosedürlerini butonlara atayınız

Option Explicit

Sub ekle()
  Dim sPicture As String, pic As Picture
  Dim yazi
  Dim i
  Dim son As Long
  Dim gecici As String

  son = Cells(Rows.Count, "A").End(3).Row
  For i = 2 To son
    yazi = Range("D" & i).Value
    gecici = Replace(yazi, " ", "")
    If gecici <> "" Then
       Set pic = ActiveSheet.Pictures.Insert("https://chart.googleapis.com/chart?chs=250x250&cht=qr&chl=" & yazi)
       Range("C" & i).Select
       With pic
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = ActiveCell.Height
        .Width = ActiveCell.Width
        .Top = ActiveCell.Top
        .Left = ActiveCell.Left
        .Placement = xlMoveAndSize
      End With
    End If
   Next i
End Sub


Sub sil()
  Dim sTemp As String
  Dim sShape As Shape
  Dim MyRange As Range
  Dim son As Long
  
  son = Cells(Rows.Count, "A").End(3).Row
  Set MyRange = Range("C1:C" & son)
  On Error Resume Next
  For Each sShape In ActiveSheet.Shapes
      If sShape.Type <> 8 And sShape.Type <> 12 Then
         sShape.Delete
      End If
  Next
End Sub

Asri bey, kod işe yaradı çok teşekkür ederim. Son bir isteğim kare kodlar oluşurken tek satır için oluşuyor biz 3 satırı birleştirdiğimiz için yükseklik ayarı yapılabilir mi ?

 

[Asri]

Asri bey, kod işe yaradı çok teşekkür ederim. Son bir isteğim kare kodlar oluşurken tek satır için oluşuyor biz 3 satırı birleştirdiğimiz için yükseklik ayarı yapılabilir mi ?

Tam anlamadım ama, karekod boyutu ise kod içinde kırmızı boyadım. Oradaki değerleri değiştirin. 300x300 gibi.

 

[endexci]

Tam anlamadım ama, karekod boyutu ise kod içinde kırmızı boyadım. Oradaki değerleri değiştirin. 300x300 gibi.

Asri bey, yardımlarınız için teşekkür ederim. Ekteki resimden istediğimi anlayabileceksiniz sanırım "S02 de oluşan karekodu ben kendim büyüterek hücrenin içine hizaladım, S09 ise makro ile kendi oluşan karekod arada yükseklik farkı var sizin bahsettiğiniz karekod boyu ayarlanıyor ama aktif hücreye yapıştırırken tek bir hücreye göre küçülüyor

 

[Asri]

Asri bey, yardımlarınız için teşekkür ederim. Ekteki resimden istediğimi anlayabileceksiniz sanırım "S02 de oluşan karekodu ben kendim büyüterek hücrenin içine hizaladım, S09 ise makro ile kendi oluşan karekod arada yükseklik farkı var sizin bahsettiğiniz karekod boyu ayarlanıyor ama aktif hücreye yapıştırırken tek bir hücreye göre küçülüyor

Kod güncellendi.

Kontrol ediniz.

 

[endexci]

Kod güncellendi.

Kontrol ediniz.

Asri bey,
Çok teşekkür ederim tam istediğim gibi oldu ellerin dert görmesin inşallah