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

Aşağı Git Tüm Forumlar İşletim Sistemleri ve Yazılımlar Yazılım Genel Ofis Uygulamaları Excel'de Google API QR Kod Boyutu Nasıl Ayarlanır?

Bu konudaki kullanıcılar: 1 misafir, 1 mobil kullanıcı

0
Cevap 221
Tıklama 0
Öne Çıkarma

1. sayfa

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

Cevap Yaz

Aykuto11

3 yıl

Konu Sahibi

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
< Resime gitmek için tıklayın >

DH forumlarında vakit geçirmekten keyif alıyor gibisin ancak giriş yapmadığını görüyoruz.

Üye olduğunda özel mesaj gönderebilir, beğendiğin konuları favorilerine ekleyip takibe alabilir ve daha önce gezdiğin konulara hızlıca erişebilirsin.

Üye Ol Şimdi Değil

Bir Daha Gösterme

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

Cevap Yaz

1. sayfa

Tüm Forumlar İşletim Sistemleri ve Yazılımlar Yazılım Genel Ofis Uygulamaları Excel'de Google API QR Kod Boyutu Nasıl Ayarlanır?