在Excel中创建条形码

时间:2015-04-27 23:38:59

标签: excel vba excel-vba

我正在使用条形码字体生成条形码,

column A text - *column B Barcode* 

我在ThisWorkbook中有以下宏可以正常工作。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If IsEmpty(Target) Or Target.Column <> 1 And Target.Column <> 4 Then Exit Sub

    Dim DataRow As Integer

    DataRow = Target.Cells.Row

    While Not IsEmpty(Cells(DataRow, Target.Column))

        Target.Worksheet.Cells(DataRow, Target.Column + 1) = "*" & Target.Worksheet.Cells(DataRow, Target.Column) & "*"

        DataRow = DataRow + 1

    Wend

End Sub

当我在A列扫描22位数字时;在B栏上想要跳过前7位,并在B栏上有最后15位数

e.g:
If 22 digit skip first 7 
If 32 digit skip first 16 & last 4 
If 34 digit skip first 22

enter image description here

2 个答案:

答案 0 :(得分:1)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim tmp,v
    Dim c As Range

    On Error Goto haveError
    For Each c in Target.Cells
        tmp=trim(c.Value)
        If Len(tmp) > 0 And (c.Column=1 Or c.Column=4) Then

            Select Case Len(tmp)
                Case 22: v = Right(tmp, Len(tmp)-7)
                Case 32: 'etc
                Case 34: 'etc
                Case Else: v=""
            End Select

            If Len(v)>0 Then 
                Application.EnableEvents = False
                c.offset(0,1).value = "*" & v & "*"
                Application.EnableEvents = True
            End If
        End If
    Next c
    Exit sub

haveError:
    Application.EnableEvents = True

End Sub

答案 1 :(得分:1)

首先,Workbook_SheetChange事件宏的 sh 参数是包含目标的工作表对象。你可以直接使用它;没有必要从 Target 中削减工作表。

接下来,在Worksheet_ChangeWorkbook_SheetChange事件宏中添加/修改/删除对象以关闭application.enableevents时,总是一个好主意,因此宏不会尝试运行当它改变/删除/在相同(或不同)的工作表上添加值时自己的顶部。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Not Intersect(Sh.Range("A:A, D:D"), Target) Is Nothing Then
        On Error GoTo Fìn
        Application.EnableEvents = False
        Dim DataRow As Long, rng As Range
        For Each rng In Intersect(Sh.Range("A:A, D:D"), Target)
            Select Case Len(rng.Value2)
                Case 0
                    'do nothing
                Case 22
                    rng.Offset(0, 1) = Chr(42) & Mid(rng.Value2, 8, 99) & Chr(42)
                Case 32
                    rng.Offset(0, 1) = Chr(42) & Mid(rng.Value2, 8, 21) & Chr(42)
                Case 34
                    rng.Offset(0, 1) = Chr(42) & Mid(rng.Value2, 23, 99) & Chr(42)
                Case Else
                    rng.Offset(0, 1) = Chr(42) & rng.Value2 & Chr(42)
            End Select
        Next rng
    End If

Fìn:
    Application.EnableEvents = True
End Sub

目标知道它所在的工作表,因此在引用目标的单元格偏移时,实际上不需要定义工作表。

基于目标中值的长度的Select Case ...结束选择`似乎是最佳解决方案,并且易于扩展。

最后,您真的需要将多个工作表用作Workbook_SheetChange事件宏,还是单个工作表的Worksheet_Change就足够了?