Şimdi Ara

Excel'de Google API QR Kod Boyutu Nasıl Ayarlanır?

Daha Fazla
Bu Konudaki Kullanıcılar: Daha Az
2 Misafir - 2 Masaüstü
5 sn
2
Cevap
0
Favori
161
Tıklama
Daha Fazla
İstatistik
  • Konu İstatistikleri Yükleniyor
0 oy
Öne Çıkar
Sayfa: 1
Giriş
Mesaj
  • Merhaba asagidaki kodu kullanarak Excel'de QR kod yapiyorum ama kenarlarinda cok bosluk kalıyor. Bunu nasıl tam sıfır gelecek sekilde ayarlayabilirim?


    Kod:

    Option Explicit.

    'other technical specifications about google chart API:

    'QR Codes | Infographics | Google Developers.


    Function URL_QRCode_SERIES( _

    ByVal PictureName As String, _

    ByVal QR_Value As String, _

    Optional ByVal PictureSize As Long = 150, _

    Optional ByVal DisplayText As String = "", _

    Optional ByVal Updateable As Boolean = True) As Variant.


    Dim oPic As Shape, oRng As Excel.Range

    Dim vLeft As Variant, vTop As Variant.

    Dim sURL As String.


    Const sRootURL As String = "https://chart.googleapis.com/chart?"

    Const sSizeParameter As String = "chs="

    Const sTypeChart As String = "cht=qr"

    Const sDataParameter As String = "chl="

    Const sJoinCHR As String = "&"


    If Updateable = False Then.

    URL_QRCode_SERIES = "outdated"

    Exit Function.

    End If.


    Set oRng = Application.Caller.Offset(, 1)

    On Error Resume Next.

    Set oPic = oRng.Parent.Shapes(PictureName)

    If Err Then.

    Err.Clear

    vLeft = oRng.Left + 4

    vTop = oRng.Top

    Else.

    vLeft = oPic.Left

    vTop = oPic.Top

    PictureSize = Int(oPic.Width)

    oPic.Delete

    End If.

    On Error GoTo 0


    If Len(QR_Value) = 0 Then.

    URL_QRCode_SERIES = CVErr(xlErrValue)

    Exit Function.

    End If.


    sURL = sRootURL & _

    sSizeParameter & PictureSize & "x" & PictureSize & sJoinCHR & _

    sTypeChart & sJoinCHR & _

    sDataParameter & UTF8_URL_Encode(VBA.Replace(QR_Value, " ", "+"))


    Set oPic = oRng.Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop, PictureSize, PictureSize)

    oPic.Name = PictureName.

    URL_QRCode_SERIES = DisplayText.

    End Function.


    Function UTF8_URL_Encode(ByVal sStr As String)

    'http://www.nonhostile.com/howto-convert-byte-array-utf8-string-vb6.asp

    Dim i As Long.

    Dim a As Long.

    Dim res As String.

    Dim code As String.


    res = ""

    For i = 1 To Len(sStr)

    a = AscW(Mid(sStr, i, 1))

    If a < 128 Then.

    code = Mid(sStr, i, 1)

    ElseIf ((a > 127) And (a < 2048)) Then.

    code = URLEncodeByte(((a \ 64) Or 192))

    code = code & URLEncodeByte(((a And 63) Or 128))

    Else.

    code = URLEncodeByte(((a \ 144) Or 234))

    code = code & URLEncodeByte((((a \ 64) And 63) Or 128))

    code = code & URLEncodeByte(((a And 63) Or 128))

    End If.

    res = res & code.

    Next i

    UTF8_URL_Encode = res.

    End Function.


    Private Function URLEncodeByte(val As Integer) As String.

    Dim res As String.

    res = "%" & Right("0" & Hex(val), 2)

    URLEncodeByte = res.

    End Function

    Excel'de Google API QR Kod Boyutu Nasıl Ayarlanır?

    < Bu ileti mobil sürüm kullanılarak atıldı >







  • 
Sayfa: 1
- x
Bildirim
mesajınız kopyalandı (ctrl+v) yapıştırmak istediğiniz yere yapıştırabilirsiniz.