開発​/Barcode​/QRコード​/Google Chart APIを使ってQRコードを作成する

-
|
|
|
|
!
 
 
 
 
 
 
 
-
!
 
 
 
 
 
 
 
 
 
-
!
 
 
 
-
!
 
 
 
 
 
 
 
 
 
-
!
 
 
-
!
-
!
 
-
!
 
 
 
 
 

'
' QRimg(QRコード化する文字列 as string)
'
' by Yuji ueno
'
Public Function QRimg(ByVal str As String) As String
    Dim TopPosition As Double
    Dim LeftPosition As Double
    Dim wkSheet As Worksheet
    Dim xRange As Range
    Dim xAddr As String
    Dim QRShape As Shape
    
    ' 文字列がなかったらエラーで終了
    If Len(str) = 0 Then
        QRimg = "False"
        Exit Function
    End If
    
    If TypeName(Application.Caller) <> "Range" Then
        QRimg = "False"
        Exit Function
    End If
    
    ' 呼ばれたワークシートを取得
    Set wkSheet = Application.Caller.Worksheet
    Set xRange = Application.Caller
    xAddr = xRange.Address
    
    ' 前にセルに貼られていた画像を削除
    Range(xAddr).Select
    For Each selectRange In Selection
        For Each myShape In wkSheet.Shapes
            Set myRange = Range(myShape.TopLeftCell, myShape.BottomRightCell)
            If Intersect(myRange, Range(xAddr)) Is Nothing = False Then
                myShape.Delete
            End If
        Next
    Next
    
    ' 画像の位置
    TopPosition = xRange.Top
    LeftPosition = xRange.Left
    
    ' QRコードを作成するリクエストを作成（Google Chart APIを使用する)
    url = "http://chart.apis.google.com/chart?cht=qr&chs=80x80&chco=000000&chl=" & str & ""
    'url = "https://bwipjs-api.metafloor.com/?bcid=qrcode&&size=100&text=" & str & ""
    
    If Not url = "" Then
        ' QRコードのイメージを表示
        Set QRShape = wkSheet.Shapes.AddPicture(url, LinkToFile:=False, SaveWithDocument:=True, Left:=LeftPosition, Top:=TopPosition, Width:=80, Height:=80)
    End If
    
    QRimg = ""
    
End Function