如何解决运行子程序后 VBA 工作簿崩溃/关闭
我有一个 VBA 代码，用于帮助我跟踪我在项目和特定任务上花费的时间。无论我在哪个选项卡上，我都以这种方式创建了自定义表单，我可以使用快捷键方便地输入我的选项卡。这是表格的图片：Custom Form
点击提交后，代码应该只获取代码中的所有信息并将其添加到特定电子表格中。这是我遇到两个不同问题之一的地方：
我有显式选项，我相信没有变体类型变量。我已将所有代码复制并粘贴到另一个电子表格中，但遇到了同样的问题。有人可以告诉我电子表格有什么问题吗？这是与代码提交按钮链接的代码。
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
解决方法
Dim AgendaArr(1 To 1,1 To 9) As String
您分配的某些值不是字符串，因此会出现类型不匹配错误。将声明类型更改为 Variant。
,您可以通过使用 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
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
