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

本帖最后由 huang1314wei 于 2017-4-13 13:52 编辑

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

1. str1 = '

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

调用barcode控件生成条形码.rar (2017-4-13 09:37 上传)

23.84 KB, 下载次数: 360

但是调用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 (2017-4-13 13:51 上传)

188 Bytes, 下载次数: 530

截图说明

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 (2017-4-13 09:47 上传)

53.06 KB, 下载次数: 701

分享到新浪微博