Excel自动生成条码工具

最新推荐文章于 2023-02-08 15:48:36 发布

taller_2000

最新推荐文章于 2023-02-08 15:48:36 发布

阅读量7k

点赞数 3

分类专栏： VBA Excel 文章标签：条码 VBA 自动条码工具 Excel

本文链接：https://blog.csdn.net/taller_2000/article/details/104352353

版权

VBA 同时被 2 个专栏收录

276 篇文章 83 订阅

订阅专栏

Excel

161 篇文章 16 订阅

订阅专栏

如果需要在Excel制作条码，大家一般会想到Microsoft Barcode控件，但是这个控件使用起来并不是很方便。其实不少网站都可以产生条码，利用Excel中的选择性粘贴可以轻松实现在工作表中插入条码图片。
示例代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objDO As Object
    Dim objPic As Object
    Dim strHTML As String
    Application.EnableEvents = False
    With Target
        If .Count = 1 Then
            If Len(.Value) > 0 And .Column = 1 Then
                Set objDO = New MSForms.DataObject
                strHTML = "<html><img src=""http://apps.99wed.com/360app/barcode/barcode.php?codebar=BCGcode128&text="
                strHTML = strHTML & .Value & "&resolution=5&thickness=30"" > " & Chr(10)
                Debug.Print strHTML
                With .Offset(0, 1)
                    .Select
                    objDO.SetText strHTML
                    objDO.PutInClipboard
                    ActiveSheet.PasteSpecial Format:="Unicode 文本", Link:=False, DisplayAsIcon:=False
                    Set objPic = Selection
                    .ColumnWidth = objPic.Width / 6.8
                    .RowHeight = objPic.Height
                End With
            End If
        End If
    End With
    Set objDO = Nothing
    Set objPic = Nothing
    Application.EnableEvents = True
End Sub

【代码解析】
第5行代码禁止系统事件激活，避免重复激活可能引起的死循环。
第7行代码判断发现变化的单元格是否为单个单元格。
第8行代码判断如果发现变化的单元格在第一列，并且单元格内容为非空，那么执行后续操作。
第9行创建DataObject对象。
第10~11行代码创建HTML代码，调整其中的codebar、resolution和thickness参数值可以获得不同类型和风格的条码。
第14行代码选择右侧单元格。
第16行代码将HTML代码放置到剪贴板。
第17行代码进行选择性粘贴。
第19~20行代码设置行高和列宽。
第25~26行代码是否对象变量占用的系统资源。
第27行代码恢复系统事件的机制。

在示例工作表第1列输入条码数字，在第二列将自动产生条码，如下图所示。

在这里插入图片描述

taller_2000

关注

3
点赞
踩
10

收藏

觉得还不错? 一键收藏
2
评论
Excel自动生成条码工具

如果需要在Excel制作条码，大家一般会想到Microsoft Barcode控件，但是这个控件使用起来并不是很方便。其实不少网站都可以产生条码，利用Excel中的选择性粘贴可以轻松实现在工作表中插入条码图片。示例代码如下：Private Sub Worksheet_Change(ByVal Target As Range) Dim objDO As Object Dim ob...
复制链接

扫一扫