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:Panoya kopyala 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 If Err Then. Err. Clear vLeft = oRng. Left + 4 vTop = oRng. Top Else. vLeft = oPic. Left vTop = oPic. Top PictureSize = Int oPic. Delete End If. On Error GoTo 0 If Len = 0 Then. URL_QRCode_SERIES = CVErr Exit Function. End If. sURL = sRootURL & _ sSizeParameter & PictureSize & "x" & PictureSize & sJoinCHR & _ sTypeChart & sJoinCHR & _ sDataParameter & UTF8_URL_Encode(VBA. Replace Set oPic = oRng. Parent. Shapes. AddPicture oPic. Name = PictureName. URL_QRCode_SERIES = DisplayText. End Function. Function UTF8_URL_Encode '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 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 As String. Dim res As String. res = "%" & Right("0" & Hex , 2) URLEncodeByte = res. End Function Dosya Ekleri 20221218_171500. jpg 164 KB · Görüntüleme: 15