Dim wsh As Worksheet
Set wsh = Application.ActiveSheet
Dim shp As Shape
For Each shp In wsh.Shapes
If shp.Type = msoPicture And InStr(shp.Name, "BarcodePicture") > 0 Then
shp.Delete
End If
Next
Dim ss As StrokeScribeClass
Set ss = CreateObject("STROKESCRIBE.StrokeScribeClass.1")
ss.Alphabet = QRCODE
pict_path = wsh.Parent.Path + "\bar.wmf"
Row = 1
Do
Dim data As String
data = wsh.Cells(Row, 1)
If Len(data) = 0 Then Exit Do
ss.text = data
rc = ss.SavePicture(pict_path, WMF, 1440, 1440)
If rc > 0 Then
MsgBox ss.ErrorDescription
Exit Do
End If
Set qrcode_cell = wsh.Cells(Row, 2)
qrcode_size = Application.Min(qrcode_cell.Width, qrcode_cell.Height)
Set shp = wsh.Shapes.AddPicture(pict_path, msoFalse, msoTrue, _
qrcode_cell.Left + (qrcode_cell.Width - qrcode_size) / 2, _
qrcode_cell.Top + (qrcode_cell.Height - qrcode_size) / 2, _
qrcode_size, qrcode_size)
shp.Name = "BarcodePicture" & Format(Row)
Row = Row + 1
Loop
Kill pict_path
Set ss = Nothing