Sub getQR() ' ' getQR Macro ' Dim resource As String 'filter out non-text cells (remove this line if you want to return QR codes for other cell types) Set sel = Selection.SpecialCells(xlTextValues) 'add a new sheet for the output Set news = Worksheets.Add() news.Name = "QR codes" Set op = news.Range("A1" ) 'do da biz For Each acc In sel resource = acc.Value 'technically you should probably escape the string, but it works without resource = "qrcode.kaywa.com/img.php?s=8&d=" & resource '140,140 is the size of the shape. This was arbitrary and is probably wrong 'using a shape is a hack to avoid a problem with Office 2007 not inserting pics from web resources Set newshape = news.Shapes.AddShape(msoShapeRectangle, op.Left, op.Top, 140, 140) 'name it in case we want to use it again later (we don't use this at the moment though) newshape.Name = resource 'get rid of the surrounding line newshape.Line.Visible = False 'load that there QR code up into the graphic newshape.Fill.UserPicture (resource) 'move to the next position on the output sheet Set op = op.Offset(11, 0).Range("A1" ) op.Value = acc.Value Set op = op.Offset(2, 0).Range("A1" ) Next ' End Sub |
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment