Question

我是这里的新手 vba 编码员。

我用用户表单创建了一个 .xlsm。在我的电脑上一切正常，但是当我通过电子邮件发送文件时，收件人在打开文件时会遇到以下问题：

我在 Workbook_Open 上添加了一个事件处理程序来自动打开用户表单。当接收者打开文件时，它会收到这个错误并且调试按钮返回到这一行：

当用户表单的提交按钮被点击时，数据应该被传输到“ThisWorkbook”，但它会创建一个新文件（我猜是以前的版本）并将数据粘贴到那里。

谁能帮我找出我的文件出了什么问题？谢谢。

下面是我的代码：

内部工作簿事件处理程序：

Sub Workbook_Open()

RunForm

End Sub

模块 1：

Option Explicit
Option Base 1

Sub PopulateComboBox()

Dim PaymentTerms() As String, PaymentFreq() As String, PaymentTermsAlt() As String
Dim i As Integer, j As Integer, m As Integer, n As Integer, o As Integer

j = WorksheetFunction.CountA(Sheets("Populate").Columns("A:A"))
n = WorksheetFunction.CountA(Sheets("Populate").Columns("B:B"))

ReDim PaymentTerms(j - 1) As String
ReDim PaymentFreq(n - 1) As String
ReDim PaymentTermsAlt(j - 1) As String

For i = 1 To j - 1
    PaymentTerms(i) = ThisWorkbook.Sheets("Populate").Range("A2:A" & (j - 1)).Cells(i, 1)
    UserForm1.ComboTerms.AddItem PaymentTerms(i)
Next i

For m = 1 To n - 1
    PaymentFreq(m) = ThisWorkbook.Sheets("Populate").Range("B2:B" & (n - 1)).Cells(m, 1)
    UserForm1.ComboFreq.AddItem PaymentFreq(m)
Next m

For o = 1 To j - 1
    PaymentTermsAlt(o) = ThisWorkbook.Sheets("Populate").Range("A2:A" & (j - 1)).Cells(o, 1)
    UserForm1.ComboTermsAlt.AddItem PaymentTermsAlt(o)
Next o

UserForm1.ComboTerms.Text = PaymentTerms(1)
UserForm1.ComboFreq.Text = PaymentFreq(1)
UserForm1.ComboTermsAlt.Text = PaymentTermsAlt(1)

End Sub

Sub RunForm()

ThisWorkbook.Sheets("Printout").Activate
UserForm1.Show

End Sub

内部用户表单：

Option Explicit

Sub CommandButton1_Click()

Application.ScreenUpdating = False

If Not IsNumeric(BasePay) Or Not IsNumeric(Interest) Then
MsgBox ("Please Enter Numeric Value for Base Pay or Interest Rate")
Exit Sub
End If

If BasePay < 0 Or Interest < 0 Then
MsgBox ("Base Pay or Interest cannot be negative value")
Exit Sub
End If

ThisWorkbook.Sheets("Printout").Range("A1") = "Prepared For " & ClientName
ThisWorkbook.Sheets("Printout").Range("O1").Value = BasePay.Text
ThisWorkbook.Sheets("Printout").Range("S2").Value = Interest.Text / 100
ThisWorkbook.Sheets("Printout").Range("L3").Value = ComboTerms.Text
ThisWorkbook.Sheets("Printout").Range("O3").Value = ComboFreq.Text
ThisWorkbook.Sheets("Printout").Range("Q2").Value = ComboTermsAlt.Text

If NewCar Then
ThisWorkbook.Sheets("Printout").Range("U2").Value = "New"
Else
ThisWorkbook.Sheets("Printout").Range("U2").Value = "Used"
End If


'----- Transfer Add-On Items to Printout Sheet ---------
Dim i           As Integer
Dim j           As Integer
Dim k           As Integer

k = 6
For i = 1 To 9
    ThisWorkbook.Sheets("Printout").Cells(k, 1).MergeArea.ClearContents
    k = k + 2
Next

k = 6
For i = 10 To 18
    ThisWorkbook.Sheets("Printout").Cells(k, 5).MergeArea.ClearContents
   k = k + 2
Next

k = 6
For i = 19 To 27
    ThisWorkbook.Sheets("Printout").Cells(k, 9).MergeArea.ClearContents
    k = k + 2
Next

k = 6
For i = 28 To 36
    ThisWorkbook.Sheets("Printout").Cells(k, 13).MergeArea.ClearContents
    k = k + 2
Next

'---- Category 1 ------
i = 6
For j = 1 To 9
    If UserForm1.Controls("Checkbox" & j).Value = True Then
        ThisWorkbook.Sheets("Printout").Range("A" & i).Value = Me.Controls("Checkbox" & j).Caption
        i = i + 2
    Else
        ThisWorkbook.Sheets("Printout").Range("A" & i).Value = ""
    End If
Next j

'---- Category 2 ------
i = 6
For j = 10 To 18
    If UserForm1.Controls("Checkbox" & j).Value = True Then
        ThisWorkbook.Sheets("Printout").Range("E" & i).Value = Me.Controls("Checkbox" & j).Caption
        i = i + 2
    Else
        ThisWorkbook.Sheets("Printout").Range("E" & i).Value = ""
    End If
Next j

'---- Category 3 ------
i = 6
For j = 19 To 27
    If UserForm1.Controls("Checkbox" & j).Value = True Then
        ThisWorkbook.Sheets("Printout").Range("I" & i).Value = Me.Controls("Checkbox" & j).Caption
        i = i + 2
    Else
        ThisWorkbook.Sheets("Printout").Range("I" & i).Value = ""
    End If
Next j

'---- Category 4 ------
i = 6
For j = 28 To 36
    If UserForm1.Controls("Checkbox" & j).Value = True Then
        ThisWorkbook.Sheets("Printout").Range("M" & i).Value = Me.Controls("Checkbox" & j).Caption
        i = i + 2
    Else
        ThisWorkbook.Sheets("Printout").Range("M" & i).Value = ""
    End If
Next j

UserForm1.Hide

End Sub

Sub CommandButton2_Click()

Unload UserForm1
UserForm1.Show

End Sub

Sub CommandButton3_Click()
Unload UserForm1
End Sub

Sub NewCar_Click()


Dim LastRow     As Integer
Dim i           As Integer
Dim j           As Integer

LastRow = WorksheetFunction.CountA(Sheets("Populate").Columns("D:D"))

'---- Count No of Checkbox
Dim Ctrl As MSForms.Control
Dim n As Integer
Dim cbcount As Long

For n = 0 To Me.Controls.Count - 1
    If Left(UserForm1.Controls(n).Name, 8) = "CheckBox" Then
        cbcount = cbcount + 1
    End If
Next n

i = 2 '--- Preset counter i
For j = 1 To cbcount
    UserForm1.Controls("Checkbox" & j).Caption = ThisWorkbook.Sheets("Populate").Cells(i, 4).Value
    i = i + 1
    
    If i > LastRow And i < (cbcount / 4) Then
        UserForm1.Controls("Checkbox" & j).Caption = ""
    End If
    
    If i > LastRow And i > (cbcount / 4 + 1) Then
        i = 2
    End If
        
Next j

End Sub

Sub UsedCar_Click()

Dim LastRow     As Integer
Dim i           As Integer
Dim j           As Integer

LastRow = WorksheetFunction.CountA(Sheets("Populate").Columns("D:D"))

'---- Count No of Checkbox
Dim Ctrl As MSForms.Control
Dim n As Integer
Dim cbcount As Long

For n = 0 To Me.Controls.Count - 1
    If Left(Me.Controls(n).Name, 8) = "CheckBox" Then
        cbcount = cbcount + 1
    End If
Next n

i = 2 '--- Preset counter i
For j = 1 To cbcount
    UserForm1.Controls("Checkbox" & j).Caption = ThisWorkbook.Sheets("Populate").Cells(i, 8).Value
    i = i + 1
    
    If i > LastRow And i < (cbcount / 4) Then
        UserForm1.Controls("Checkbox" & j).Caption = ""
    End If
    
    If i > LastRow And i > (cbcount / 4 + 1) Then
        i = 2
    End If
        
Next j

End Sub

Sub UserForm_Initialize()

Call PopulateComboBox

'----- Rename Frame Boxes Caption
Dim k As Integer, nc As Integer
nc = 1
For k = 2 To 5
    Me.Controls("Frame" & k).Caption = ThisWorkbook.Sheets("Printout").Cells(5, nc)
    nc = nc + 4
Next k
'--------------------------------------------------


Dim LastRow     As Integer
Dim i           As Integer
Dim j           As Integer

LastRow = WorksheetFunction.CountA(ThisWorkbook.Sheets("Populate").Columns("D:D"))

'---- Count No of Checkbox
Dim Ctrl As MSForms.Control
Dim n As Integer
Dim cbcount As Long

For n = 0 To Me.Controls.Count - 1
    If Left(Me.Controls(n).Name, 8) = "CheckBox" Then
        cbcount = cbcount + 1
    End If
Next n

i = 2 '--- Preset counter i
For j = 1 To cbcount
    UserForm1.Controls("Checkbox" & j).Caption = ThisWorkbook.Sheets("Populate").Cells(i, 4).Value
    i = i + 1
    
    If i > LastRow And i < (cbcount / 4) Then
        UserForm1.Controls("Checkbox" & j).Caption = ""
    End If
    
    If i > LastRow And i > (cbcount / 4 + 1) Then
        i = 2
    End If
        
Next j
    
End Sub

Answer 1

操作系统的安全警告和默认设置问题。在打开此文件之前，您的寻址者需要执行以下操作： 1.在文件上单击鼠标右键 2.选择属性 3.按解锁（下图）之后，一切正常。如果你从网上下载你自己的文件，你可以自己测试。

通过电子邮件发送时出现 xlsm 文件错误

1 个答案: