VBA调用bartender软件实现批量生成条形码

huang1314wei

  2015年8月发过一个贴子，就是关于批量生成条形码的贴子，原贴地址  http://club.excelhome.net/thread-1223631-1-1.html  原贴中使用的原理就是 通过网络，把一些免费的在线条码生成网站上的图片通过VBA抓取到表格，但是使用这个方法有一些弊端，比如电脑必须联网，有的时候因为电脑系统原因，比如Activesheet.paste报错，也有可能网站关闭或者规则变更导致批量生成失败，以致于经常有人给我留言说代码用不了，报错的什么的，有的时候一个一个回复起来也有点力不从心，最近又有坛友联系我说该贴子二楼的附件只支持  code-128码生成， 不支持code-39码和codabar码的生成，实际上，我连接的那个网站支持code-39的，就是把 代码当中的

1. str1 = "<table><img src=""http://apps.99wed.com/360app/barcode/barcode.php?codebar=BCGcode128&text="

复制代码

当中的128改成39就可以生成code39码了，但是由于网站没有codabar码的类型，因此不能生成codabar码  ，为了解决这个问题，我花了一点时间做了一个利用VBA调用自带的barcode control插件生成条形码，附件如下：

调用barcode控件生成条形码.rar (23.84 KB, 下载次数: 2404)

2017-4-13 09:37 上传

点击文件名下载附件

但是调用barcode control插件 生成的 codabar类型的条码打印出来不能扫描，具体原因不明，坛子里有很多调用自带的barcode control 生成条码的例子，我也不做过多的介绍了，为了解决codabar码打印出来不能扫描的问题，借此契机，我发现了一款软件bartender，这个软件生成条形码确实非常强大，以下是bartender软件介绍，来自百科

Bartender[1] 是一种条码打印软件，是目前在行业中使用最多的软件。由美国seagull scientific提供,堪称标签打印方面全球领先者。BarTender 是美国海鸥科技推出的一款优秀的条码打印软件。 BarTender 是最快速,最容易设计专业、高质量标签的条码打印软件。应用于 WINDOWS95 、 98 、 NT 、 XP 、 2000 、 2003 和 3.1 版本。 产品支持广泛的条形码码制和条形码打印机， 不但支持条形码打印机而且支持激光打印机。还为世界知名品牌条形码打印机开发了增强驱动。在为条形码打印机提供真正的 Windows 驱动程序这一领域，海鸥科技已经是世界上最大的软件开发商。Seagull Scientific 因 BarTender 而闻名于世。BarTender 是一个行业领先的标签设计和条形码软件。还是全球领先的条形码和感热打印机的标准 Windows打印机驱动程序开发商。

这个软件确实强大，提供了二次开发的SDK，可以用VB，C#，.Net等语言进行二次开发，同时在excel当中也可以非常方便的调用，本次用VBA调用生成条码只是用到了其中某一两个属性和方法的

前提说明：使用以下附件，您必须在电脑上安装bartender软件，推荐下载安装bartender 9.4 XX版，其中的XX代表什么，我不多说了，软件安装完了，才可以使用以下代码附件

bartender9.4下载地址.rar (188 Bytes, 下载次数: 3360)

2017-4-13 13:51 上传

点击文件名下载附件

截图说明

1. Private Sub CommandButton1_Click()
   
2.     Dim i%, n%, FilePath$, str$, sh As Shape
   
3.     Dim btApp As BarTender.Application
   
4.     Dim btFormat As BarTender.Format
   
5.     For i = 1 To 3
   
6.         If Me.Controls("OptionButton" & i).Value = True Then
   
7.             str = Me.Controls("OptionButton" & i).Caption
   
8.             FilePath = ThisWorkbook.Path & "" & str & ".btw"
   
9.             n = n + 1
   
10.         End If
    
11.     Next
    
12.     If n = 0 Then
    
13.         MsgBox "你没有选择条码类型！生成失败！"
    
14.         Exit Sub
    
15.     End If
    
16.     If Len(Dir(FilePath)) = 0 Then
    
17.         MsgBox "当前目录没有找到 “" & str & "” 文件批量生成失败！", vbInformation, "重要提醒"
    
18.         Exit Sub
    
19.     End If
    
20.     Application.ScreenUpdating = False
    
21.     If Application.CountA(Range("A:A")) = 0 Then
    
22.         MsgBox "A列单号为空，程序退出!"
    
23.         Exit Sub
    
24.     End If
    
25.     For Each sh In Sheet1.Shapes
    
26.         If sh.Type = 11 Then sh.Delete
    
27.     Next
    
28.     i = Range("A1048576").End(xlUp).Row
    
29.     Set btApp = CreateObject("BarTender.Application")
    
30.     btApp.Visible = False
    
31.     Set btFormat = btApp.Formats.Open(FilePath)
    
32.     For j = 1 To i
    
33.        If Cells(j, 1) <> "" Then
    
34.            btFormat.SetNamedSubStringValue "Var1", Cells(j, 1)
    
35.            btFormat.ExportToFile ThisWorkbook.Path & "" & str & ".jpg", "jpg", btColors24Bit, btResolutionPrinter, btDoNotSaveChanges
    
36.            Sheet1.Shapes.AddPicture(ThisWorkbook.Path & "" & str & ".jpg", msoTrue, msoCTrue, Cells(j, 2).Left, Cells(j, 2).Top, Cells(j, 2).Width, Cells(j, 2).Height).Select
    
37.            Kill ThisWorkbook.Path & "" & str & ".jpg"
    
38.        End If
    
39.     Next
    
40.     btFormat.Close btDoNotSaveChanges
    
41.     btApp.Quit
    
42.     Unload Me
    
43. End Sub

复制代码

附件在此

VBA调用bartender批量生产打印条形码.rar (53.06 KB, 下载次数: 4408)

2017-4-13 09:47 上传

点击文件名下载附件

huang1314wei

新的方法批量生成条形码和二维码，看这里
http://club.excelhome.net/thread-1369455-1-1.html

huang1314wei

怎么审核要这么久？

89北滘

本帖太强大！皇上万岁万岁万万岁！

huang1314wei

89北滘 发表于 2017-4-25 15:17
本帖太强大！皇上万岁万岁万万岁！

感觉支持，你还是第一个顶贴的

pjoil

此贴太有用，感谢楼主的分享，佩服楼主的水平！！

huang1314wei

pjoil 发表于 2017-5-6 15:56
此贴太有用，感谢楼主的分享，佩服楼主的水平！！

不客气，感谢你的顶贴，这个论坛向来伸手党比较多，只知道下载附件，不知道顶贴

lzqlaj

谢谢分享，送红花。

lzqlaj

bartender太大，以后在测试，先收藏。

nove

正需要，感谢。太牛了。再次谢过

zhao__feng

楼主，最好做几个二维码的调用，谢谢