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 < Bu ileti mobil sürüm kullanılarak atıldı > |
Bildirim