在宏中调用该函数

时间:2017-03-22 17:08:49

标签: excel vba excel-vba code128

我在excel visual basic中添加了一个函数,如下所示,它将字符串转换为条形码,从blog

获取

enter image description here

   Public Function Code128(SourceString As String)

  Dim Counter As Integer
  Dim CheckSum As Long
  Dim mini As Integer
  Dim dummy As Integer
  Dim UseTableB As Boolean
  Dim Code128_Barcode As String

  If Len(SourceString) > 0 Then

    'Check for valid characters
    For Counter = 1 To Len(SourceString)

        Select Case Asc(Mid(SourceString, Counter, 1))

            Case 32 To 126, 203

            Case Else

                MsgBox "Invalid character in barcode string." & vbCrLf & vbCrLf & "Please only use standard ASCII characters", vbCritical
                Code128 = ""
                Exit Function

        End Select

    Next

    Code128_Barcode = ""
    UseTableB = True

    Counter = 1
    Do While Counter <= Len(SourceString)

        If UseTableB Then

            'Check if we can switch to Table C
            mini = IIf(Counter = 1 Or Counter + 3 = Len(SourceString), 4, 6)
            GoSub testnum

            If mini% < 0 Then 'Use Table C

                If Counter = 1 Then

                    Code128_Barcode = Chr(205)

                Else 'Switch to table C

                    Code128_Barcode = Code128_Barcode & Chr(199)

                End If

                UseTableB = False

            Else

                If Counter = 1 Then Code128_Barcode = Chr(204) 'Starting with table B

            End If

        End If

        If Not UseTableB Then

            'We are using Table C, try to process 2 digits
            mini% = 2
            GoSub testnum

            If mini% < 0 Then 'OK for 2 digits, process it

                dummy% = Val(Mid(SourceString, Counter, 2))
                dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
                Code128_Barcode = Code128_Barcode & Chr(dummy%)
                Counter = Counter + 2

            Else 'We haven't got 2 digits, switch to Table B

                Code128_Barcode = Code128_Barcode & Chr(200)
                UseTableB = True

            End If

        End If

        If UseTableB Then

            'Process 1 digit with table B
            Code128_Barcode = Code128_Barcode & Mid(SourceString, Counter, 1)
            Counter = Counter + 1

        End If

    Loop

    'Calculation of the checksum
    For Counter = 1 To Len(Code128_Barcode)

        dummy% = Asc(Mid(Code128_Barcode, Counter, 1))
        dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)

        If Counter = 1 Then CheckSum& = dummy%

        CheckSum& = (CheckSum& + (Counter - 1) * dummy%) Mod 103

    Next

    'Calculation of the checksum ASCII code
    CheckSum& = IIf(CheckSum& < 95, CheckSum& + 32, CheckSum& + 100)

    'Add the checksum and the STOP
    Code128_Barcode = Code128_Barcode & Chr(CheckSum&) & Chr$(206)
End If

Code128 = Code128_Barcode

Exit Function


     testnum:

    'if the mini% characters from Counter are numeric, then mini%=0
    mini% = mini% - 1
    If Counter + mini% <= Len(SourceString) Then

        Do While mini% >= 0

            If Asc(Mid(SourceString, Counter + mini%, 1)) < 48 Or Asc(Mid(SourceString, Counter + mini%, 1)) > 57 Then Exit Do
            mini% = mini% - 1

        Loop

    End If

    Return

   End Function

我需要在我创建的用于格式化单元格的宏中调用此函数。我是宏和vba函数的新手。现在我不知道如何在宏中调用这些函数并将列A传递给循环中的函数。所以A列中的所有值都转换为条形码

With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintGridlines = True

.Orientation = xlLandscape
.PaperSize = xlPaperA4

 .Zoom = False
 .FitToPagesWide = 1
 .FitToPagesTall = False

  End With

  For Each Target In Range(Cells(1, 1), Cells(65536, 1).End(xlUp))
   If Target <> "" Then
   With Range(Target, Target.Offset(0, 11))
   .WrapText = True
  End With
   End If
  Next

2 个答案:

答案 0 :(得分:1)

我不完全确定你的意思&#34;将字体设置为Code128&#34;所以这是我最好的猜测

With ActiveSheet.PageSetup
    .PrintTitleRows = "$1:$1"
    .PrintGridlines = True
    .Orientation = xlLandscape
    .PaperSize = xlPaperA4
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = False
End With

For Each Target In Range("A1", Range("A" & Rows.Count).End(xlUp))
    If Target.Value <> vbNullString Then
        Target.Value = Code128(Target.Value)
        Target.Resize(, 12).WrapText = True
    End If
Next

答案 1 :(得分:0)

Application.WorksheetFunction.Code128(tempString)

确保Option Explicit位于您的函数顶部(如果您有Public函数,可能不需要,不确定)

相关问题