Question

我有一个 VBA 代码，用于帮助我跟踪我在项目和特定任务上花费的时间。无论我在哪个选项卡上，我都以这种方式创建了自定义表单，我可以使用快捷键方便地输入我的选项卡。这是表格的图片：Custom Form

点击提交后，代码应该只获取代码中的所有信息并将其添加到特定电子表格中。这是我遇到两个不同问题之一的地方：

提交 1 或 2 次后，即使之前的提交没有错误，我也会收到一个变量不匹配错误。当我尝试调试代码时，Excel 关闭并在我重新打开它后告诉我代码已损坏。
我将单击或尝试更改电子表格中的某些内容，Excel 将关闭而不会发出任何警告，甚至不会通知我代码是否已损坏。

我有显式选项，我相信没有变体类型变量。我已将所有代码复制并粘贴到另一个电子表格中，但遇到了同样的问题。有人可以告诉我电子表格有什么问题吗？这是与代码提交按钮链接的代码。

Private Sub SubmitButton_Click()

Dim EditIndex As Integer
EditIndex = ProjectTaskLog.IndexInput.Value
If EditIndex > 1 Then
    Call EditEntry
Call ProjectTaskLogForm.EditEntry
Else
    Call ProjectTaskLogForm.PTSubmit
End If

以下是与将表单值提交到电子表格相关的代码：

Sub PTSubmit()

Dim Agenda As Worksheet
Set Agenda = ThisWorkbook.Worksheets("agenda")

Dim Submission As PTLog
Set Submission = New PTLog
With Submission
    .Project = ProjectTaskLog.ProjectCmb.Value
    .OrderNumber = ProjectTaskLog.OrderCmb.Value
    .Task = ProjectTaskLog.TaskCmb.Value
    .Detail = ProjectTaskLog.DetailInput
    .StartT = ProjectTaskLog.StartInput.Value
    .EndT = ProjectTaskLog.EndInput.Value
    .Hours = ProjectTaskLog.HoursInput.Value
    '.SDate = ProjectTaskLog.DateInput.Value
    .OTStatus = ProjectTaskLog.OTSInput.Value
    .Overtime = ProjectTaskLog.OvertimeInput.Value
    If .Overtime > 0 Then .Hours = .Hours - .Overtime
End With

Dim IRow As Long
IRow = Agenda.Range("c1").End(xlDown).Row + 1
Dim AgendaArr(1 To 1, 1 To 9) As String
        AgendaArr(1, 1) = Date
        AgendaArr(1, 3) = Submission.OrderNumber
        AgendaArr(1, 4) = Submission.Project
        AgendaArr(1, 5) = Submission.Task
        AgendaArr(1, 6) = Submission.Detail
        AgendaArr(1, 2) = "NO"
        AgendaArr(1, 7) = Submission.Hours
        AgendaArr(1, 8) = Submission.StartT
        AgendaArr(1, 9) = Submission.EndT
        Agenda.Range("c" & IRow, "k" & IRow) = AgendaArr
If Submission.Overtime > 0 Then
    IRow = IRow + 1

    AgendaArr(1, 1) = Format(Submission.SDate, "m/dd/yyyy")
    AgendaArr(1, 2) = "YES"
    AgendaArr(1, 3) = Submission.OrderNumber
    AgendaArr(1, 4) = Submission.Project
    AgendaArr(1, 5) = Submission.Task
    AgendaArr(1, 6) = Submission.Detail
    AgendaArr(1, 7) = Submission.Overtime
    AgendaArr(1, 8) = Submission.StartT
    AgendaArr(1, 9) = Submission.EndT
    Agenda.Range("c" & IRow, "k" & IRow) = AgendaArr
End If

End Sub

Answer 1

Dim AgendaArr(1 To 1, 1 To 9) As String

您分配的某些值不是字符串，因此会出现类型不匹配错误。将声明类型更改为 Variant。

Answer 2

您可以通过使用 PTLog 对象上的方法将值从表单保存到工作表来消除数组，这应该避免类型不匹配错误。

Sub PTSubmit()
    
    Dim p As New PTLog
    Call p.Init(Me)
    Call p.Save(ThisWorkbook.Sheets("agenda"))

End Sub

PTLog 类模块

Public Project As String
Public OrderNumber As String, Task As String, Detail As String
Public StartT As String, EndT As String, sDate As Date
Public OTStatus As String
Public Hours As Single, Overtime As Single

' initilize object
Function Init(frm As Object)
    With frm
        Project = .ProjectCmb.Value
        OrderNumber = .OrderCmb.Value
        Task = .TaskCmb.Value
        Detail = .DetailInput
        StartT = .StartInput.Value
        EndT = .EndInput.Value
        Hours = Val(.HoursInput.Value)
        sDate = Format(.DateInput.Value, "m/dd/yyyy")
        OTStatus = .OTSInput.Value
        Overtime = Val(.OvertimeInput.Value)
   End With
   If Overtime > 0 Then Hours = Hours - Overtime
End Function

' save object to sheet
Function Save(ws As Worksheet)
    Dim i As Long, z As Integer, n As Integer
    i = ws.Cells(rows.Count, 3).End(xlUp).Row + 1

    z = 1
    If Overtime > 0 Then z = 2

    For n = 1 To z
        With ws
            .Cells(i, "C") = Format(sDate, "m/dd/yyyy")
            If n = 1 Then
                .Cells(i, "D") = "NO"
                .Cells(i, "I") = Hours
            Else
                .Cells(i, "D") = "YES"
                .Cells(i, "I") = Overtime
            End If
            .Cells(i, "E") = OrderNumber
            .Cells(i, "F") = Project
            .Cells(i, "G") = Task
            .Cells(i, "H") = Detail
            .Cells(i, "J") = StartT
            .Cells(i, "K") = EndT
        End With
        i = i + 1
    Next

End Function

运行子程序后 VBA 工作簿崩溃/关闭

2 个答案: