How to stream a barcode image in Excel
We developed a useful way to stream a barcode image from the Dynamic Barcode Generator Subscription (live online demo) to Excel.
• Excel cannot truly put the picture in the cell, but this VBA code adjusts the cells to the image object's height.
• The user must delete the pictures manually.
• The user must reset the row height and width to new data height/width.
• The images are placed directly in the column to the right of the data.
• Feel free to use this code in any way and make any modifications.
To add/change barcode parameters/properties, modify the parameters variable.
To modify the range of cells, change the a2:a10 to a single cell, a different range (a12:a22), or specific cells (a2,a4,a12).
To Implement in Excel:
1. Except for the current worksheet, close all other worksheets (very important).
2. From the standard worksheet view, enter the Visual Basic Editor (VBE):
• Windows Instructions
• Mac Instructions
3. In the VBE's left-hand panel, choose VBAProject(CurrentWorksheet).
4. From the Excel menu, choose Insert, then Module. A new Modules folder will show, with a new Module underneath (which may be renamed).
5. In the new Module's white space on the right hand side, copy and paste the below VBA code.
6. From the Excel menu, choose File, Save. If prompted, save the worksheet as an Excel macro-enabled workbook (which has the XLSM extension). If this step is not performed, the VBA will not be retained in the workbook, due to Excel security settings.
7. Once the above step has been performed, close the VBE window:
• Modify the range of cells.
• On the Developer tab, under Visual Basic, choose Macros, run IDABCGen.
Dim cell, parameters, shp As Shape, target As Range
Set KeyCells = ActiveSheet.Range("a2:a10") ' range with names
parameters = "I = JPEG" 'add extra parameters here (it is suggested to keep I = JPEG)
For Each cell In KeyCells
If cell <> "" Then
myurl = "http://www.bcgen.com/demo/linear-dbgs.aspx?" & parameters & "&D=" & cell
filenam = myurl
Set shp = Selection.ShapeRange.Item(1)
.LockAspectRatio = msoFalse
'.Width = 50 'Adjust width (by trial and error)
'.Height = 50 'Adjust width (by trial and error)
Cells(cell.Row, cell.Column + 1).PasteSpecial
'Adjust the rows next to the image objects
For Each Picture In ActiveSheet.DrawingObjects
PictureTop = Picture.Top
PictureLeft = Picture.Left
PictureHeight = Picture.Height
PictureWidth = Picture.Width
For N = 2 To 256
If Columns(N).Left > PictureLeft Then
PictureColumn = N - 1
For N = 2 To 65536
If Rows(N).Top > PictureTop Then
PictureRow = N - 1
Rows(PictureRow).RowHeight = PictureHeight
Columns(PictureColumn).ColumnWidth = PictureWidth * (54.29 / 288)
Picture.Top = Cells(PictureRow, PictureColumn).Top
Picture.Left = Cells(PictureRow, PictureColumn).Left
Windows Excel (2003+), Mac Excel (2004 and 2011+)
01-20-15 7.8 year(s) ago