Teknoloji Haberleri
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 220
Tıklama 0
Öne Çıkarma
Cevap 220
Tıklama 0
Öne Çıkarma
1. sayfa
-
Excel'de Google API QR Kod Boyutu Nasıl Ayarlanır?
1. sayfa
DH Mobil uygulaması ile devam edin.
Mobil tarayıcınız ile mümkün olanların yanı sıra, birçok yeni ve faydalı özelliğe erişin.
Gizle ve güncelleme çıkana kadar tekrar gösterme.
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 >
< Bu ileti mobil sürüm kullanılarak atıldı >