Question

我一直在寻找一种暂停宏的方法，并允许用户在恢复之前手动将“城市”输入到工作表上的单元格中。我发现了许多不同的方法，但不幸的是，我的编程知识似乎不能完成实现建议的任务。一种方法建议使用GetTickCount，但我确定我遗漏了一些内容，因为我收到Argument not Optional消息。代码如下，任何建议或方向表示赞赏。提前感谢您的时间。

编辑：有一些回复暗示了不同的方法，但我不了解为什么GetTickCount失败。有什么输入吗？谢谢。

    Option Explicit
    Option Compare Text
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "gettickcount64" (cytickcount As Currency) As LongPtr

    Sub AddPickups()
        Dim VendorList(100) As String, WeightList(100) As Double, PieceList(100) As Double, POList(100) As String, RKList(100) As Double, _
i As Integer, finished_button As Boolean, j As Integer, File_Path As _
String, CurrentDate As Date, DateString As String, SameVendorFlag As Boolean

    i = 1
    Range("a2").Select

    Do Until finished_button = True
        If SameVendorFlag = True Then
            VendorList(i) = VendorList(i - 1)
        Else
            VendorList(i) = InputBox("Please enter the name of the vendor.", "Add Vendor")
        End If
        ActiveCell.Offset(i - 1, 2).Value = VendorList(i)
        WeightList(i) = InputBox("Please enter the weight of the shipment.", "Add Weight")
        ActiveCell.Offset(i - 1, 0).Value = WeightList(i)
        PieceList(i) = InputBox("Please enter the number of pieces in the shipment.", "Add Pieces")
        ActiveCell.Offset(i - 1, 1).Value = PieceList(i)
        POList(i) = InputBox("Please enter the digits after ""SB000"" from the PO number of the shipment.", "Add PO #s")
        POList(i) = "SB000" & POList(i)
        ActiveCell.Offset(i - 1, 6).Value = POList(i)
        If MsgBox("Would you like to add another pickup?", vbYesNo) = vbYes Then
            i = i + 1
            If MsgBox("Is it the same vendor?", vbYesNo) = vbYes Then
                SameVendorFlag = True
            Else
                SameVendorFlag = False
            End If
        Else
            finished_button = True
            If MsgBox("Are any of the pickups outside of the City?", vbYesNo) = vbYes Then
                MsgBox ("System will pause for 2 minutes so you can add the city information")
                Call WasteTime(120)
            End If
        End If
    Loop

    CurrentDate = Date
    DateString = Format(Date, "mm-dd-yy")

    Call Sort
    Call AssignRK(i)

    If MsgBox("Are you finished adding pickups?", vbYesNo) = vbYes Then
        ActiveSheet.Shapes("Button 1").Delete
        Application.DisplayAlerts = False
        File_Path = "FilePath goes here"
        ActiveWorkbook.SaveAs Filename:=File_Path & "FileName" & " - " _
            & DateString & ".xlsx", FileFormat:=51, CreateBackup:=False
        Application.DisplayAlerts = True
    End If
    End Sub

    Sub AssignRK(i)
    Dim LastRK As Double, FirstRK As Double, j As Integer

    LastRK = InputBox("Please enter the highest RK number PREVIOUSLY USED", "RK Number")
    FirstRK = LastRK + 1
    Range("f2").Select
    For j = 1 To i
        If j = 1 Then
            ActiveCell.Offset(j - 1, 0).Value = FirstRK
        Else
            ActiveCell.Offset(j - 1, 0).Value = FirstRK + (j - 1)
        End If
    Next j
    End Sub

    Sub Sort()
    Range("RegionTag").CurrentRegion.Select
    Range("RegionTag").CurrentRegion.Sort key1:=Range("CitySort"), order1:=xlAscending, Header:=xlYes, key2:=Range("VendorSort"),        order1:=xlAscending, Header:=xlYes, key3:=Range("POSort"), order1:=xlAscending, Header:=xlYes
    End Sub

    Sub WasteTime(Finish As Long)

    Dim NowTick As Long
    Dim EndTick As Long

    EndTick = getTickCount + (Finish * 1000)

    Do
        NowTick = getTickCount
        DoEvents
        Loop Until NowTick >= EndTick
    End Sub

Answer 1

您可以通过以下操作获取城市名称：

If MsgBox("Are any of the pickups outside of the City?", vbYesNo) = vbYes Then
    Dim City as String
    City = InputBox("Provide City Name")
    Worksheets("Sheet1").Range("C10") = City
End If

Answer 2

如果您希望用户与您的代码进行交互，您是否尝试使用InputBox？

/// Convert given unicode character code into unicode char reference
///
/// @example scss 
///   unicode("e655"); 
///   // "\e655"
///
/// @source - [@Stephn-R](https://github.com/sass/sass/issues/1395#issuecomment-57483844)
/// @param string $str   Unicode character code to convert
/// @return string
@function unicode($str) {
    @if (str-slice($str, 1, 1) != str-slice("\\", 1, 1)) {
        $str: unquote(str-insert($str, str-slice("\\", 1, 1), 1));
    }
    @return unquote("\"")+$str+unquote("\"")
}

您可以在以下位置查看示例： http://www.excel-easy.com/vba/examples/inputbox-function.html

InputBox事件会自动暂停代码执行，直到用户输入一些数据。 请勿忘记验证用户输入的数据。

Answer 3

我最终能够找到一个涉及modeless userform的解决方案，该解决方案可以暂停执行，直到单击userform命令按钮。其余代码在按钮单击子项中执行。谢谢你的帮助。

如何暂停vba-excel宏并允许用户交互

3 个答案: