在宏中调用函数

Question

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

中获取的条形码

   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 列传递给 loop.So 中的函数 A 列中的所有值都转换为条形码

With ActiveSheet.PageSetup
.PrintTitleRows = ":"
.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

Answer 1

我不完全确定你说的 "set the font to Code128" 是什么意思，所以这是我最好的猜测

With ActiveSheet.PageSetup
    .PrintTitleRows = ":"
    .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

Answer 2

Application.WorksheetFunction.Code128(tempString)

确保 Option Explicit 位于函数的顶部（如果您有 Public 函数，则可能不需要，不确定）

在宏中调用函数

Call the function in macros

vba

excel

code128