运行子例程后VBA工作簿崩溃/关闭
运行子例程后VBA工作簿崩溃/关闭
提问于 2021-03-02 17:49:10
我有一个VBA代码，它可以帮助我跟踪我花在项目和特定任务上的时间。我用这种方式创建了一个自定义表单，无论我在哪个选项卡上，我都可以使用一个快捷键方便地输入我的选项卡。下面是表单的图片：自定义形式
一旦您点击submit，代码应该只获取代码中的所有信息并将其添加到特定的电子表格中。这就是我遇到两个不同问题之一的地方：
- 在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回答 2
Stack Overflow用户
发布于 2021-03-02 21:05:08
Dim AgendaArr(1 To 1, 1 To 9) As String您指定的一些值不是字符串，因此会出现类型不匹配错误。将声明类型更改为变体。
Stack Overflow用户
发布于 2021-03-03 12:04:19
您可以通过使用PTLog对象上的方法将值从表单保存到工作表，从而消除数组，这将避免类型不匹配的错误。
Sub PTSubmit()
Dim p As New PTLog
Call p.Init(Me)
Call p.Save(ThisWorkbook.Sheets("agenda"))
End SubPTLog类模块
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/66444548
复制相关文章
相似问题
腾讯云开发者
