FulanoNadie
|
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.
Notes:
• 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 the 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, and run IDABCGen.
VBA Macro:
Sub 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
ActiveSheet.Pictures.Insert(filenam).Select
Set shp = Selection.ShapeRange.Item(1)
With shp
.LockAspectRatio = msoFalse
'.Width = 50 'Adjust width (by trial and error)
'.Height = 50 'Adjust width (by trial and error)
.Cut
End With
Cells(cell.Row, cell.Column + 1).PasteSpecial
End If
'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
Exit For
End If
Next N
For N = 2 To 65536
If Rows(N).Top > PictureTop Then
PictureRow = N - 1
Exit For
End If
Next N
Rows(PictureRow).RowHeight = PictureHeight
Columns(PictureColumn).ColumnWidth = PictureWidth * (54.29 / 288)
Picture.Top = Cells(PictureRow, PictureColumn).Top
Picture.Left = Cells(PictureRow, PictureColumn).Left
Next Picture
Next
End Sub
Operating System:
Windows, Mac
Application:
Windows Excel (2003+), Mac Excel (2004 and 2011+)
01-20-15  9.8 year(s) ago
 Report Abuse
|
Email this question link to friends 
My Profile 
