在宏中调用函数

Posted 2023-03-31

【中文标题】在宏中调用函数

【英文标题】：Call the function in macros

【发布时间】：2017-08-14 23:04:41

【问题描述】：

我在 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列循环传递给函数。所以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

【问题讨论】：

认为您需要发布所有代码。如果您使用 Google 自定义函数，我相信您会找到有关如何调用的指导。

@SJR 我试过谷歌搜索，不知道如何遍历列来调用函数。这就是我在这里寻求帮助的原因

好的，把功能代码贴出来。您是在问如何从上面发布的代码中调用它吗？

以上是宏。我现在把功能代码贴出来

A 列中的所有值都是字符串吗？您希望将它们替换为通过公式传递的结果，还是放置在其他位置的结果？

【参考方案1】：

我不完全确定“将字体设置为 Code128”是什么意思，所以这是我的最佳猜测

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

【讨论】：

如何设置A列的字体样式

这是一个不同的问题。看起来该链接包含有关如何安装字体的说明。

是的，我确实安装了字体。但我不确定当Target.Font = Code 128 抛出错误时如何设置一列

猜测但尝试 Target.Font = "Code 128" 或者您可以像第 7 步中那样手动操作。

我在 Target.Value = Code128(Target.Value) 中收到运行时错误 424

【参考方案2】：

Application.WorksheetFunction.Code128(tempString)

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