str1 = '
Private Sub CommandButton1_Click()
Dim i%, n%, FilePath$, str$, sh As Shape
Dim btApp As BarTender.Application
Dim btFormat As BarTender.Format
For i = 1 To 3
If Me.Controls('OptionButton' & i).Value = True Then
str = Me.Controls('OptionButton' & i).Caption
FilePath = ThisWorkbook.Path & '' & str & '.btw'
n = n + 1
End If
Next
If n = 0 Then
MsgBox '你没有选择条码类型!生成失败!'
Exit Sub
End If
If Len(Dir(FilePath)) = 0 Then
MsgBox '当前目录没有找到 “' & str & '” 文件批量生成失败!', vbInformation, '重要提醒'
Exit Sub
End If
Application.ScreenUpdating = False
If Application.CountA(Range('A:A')) = 0 Then
MsgBox 'A列单号为空,程序退出!'
Exit Sub
End If
For Each sh In Sheet1.Shapes
If sh.Type = 11 Then sh.Delete
Next
i = Range('A1048576').End(xlUp).Row
Set btApp = CreateObject('BarTender.Application')
btApp.Visible = False
Set btFormat = btApp.Formats.Open(FilePath)
For j = 1 To i
If Cells(j, 1) <> '' Then
btFormat.SetNamedSubStringValue 'Var1', Cells(j, 1)
btFormat.ExportToFile ThisWorkbook.Path & '' & str & '.jpg', 'jpg', btColors24Bit, btResolutionPrinter, btDoNotSaveChanges
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
Kill ThisWorkbook.Path & '' & str & '.jpg'
End If
Next
btFormat.Close btDoNotSaveChanges
btApp.Quit
Unload Me
End Sub
联系客服