0

我构建了一个用户表单，允许在宏生成的字符串成为新电子表格的一部分之前对其进行修改。正如所写，我担心它会有多大的弹性。

该表单有一个名为的文本框，其中转储CourseDescription了一个字符串值：strBundleDescription

frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show

然后，用户可以根据需要编辑文本并按 OK 将文本传递给正在创建的电子表格。

单击确定后，修改后的字符串将放入Range("B7")电子表格中：

Private Sub cmdOK_Click()

    Dim strValue As String

    strValue = CourseDescription.Value
    If strValue <> "" Then
        Range("B7").Value = strValue
    End If
    Unload Me

End Sub

到目前为止，这在实践中有效，但我之前遇到过无法解释的焦点问题。我担心在某些（未知）情况下焦点可能会转移到另一个打开的工作表，并且文本将被粘贴到它不属于的地方。

我的问题：我想要一个更明确的位置是否正确，或者像上面这样的简单范围定义是否足够？如果建议更明确的位置，有没有办法传递信息，wkbSaba如shtCourse不创建公共变量

我发现的所有潜在解决方案都涉及某种形式的公共变量，但原则上（无论对错）当信息仅用于一个函数（如本例中）时，我都试图避免公共变量。

完整代码，根据要求：这是完整的宏代码。frmDescriptionReview在注释标签“'输入捆绑描述的基本信息”下的调用大约是 3/4。

我将按照您的建议尝试 Property 调用，这是我不知道的事情，并且在网络搜索将数据传递给用户表单的方法时也没有见过。有很多东西要学！看起来变量确实可以这样传递。

Option Explicit

Sub TransferData()


'***************************************
' TO USE THIS MACRO:
' 1. Make sure that all information for the bundle is included
'    on the 'km notification plan' and 'bundle details (kbar)' tabs
'    of the Reporting_KMFramework.xlsx
' 2. Select the bundle name on the 'km notification plan' tab.
' 3. Start the macro and it should create the basis of the Saba
'    form
' 4. Read through the entire form, especially the bundle
'    description, to be sure it is complete and accurate.
'***************************************


'establish variables

    Dim iRow As Integer

    Dim sTxt As String
    Dim sTxt2 As String
    Dim sBundleName As String
    Dim sNumber As String

    Dim aSplit() As String
    Dim aSplit2() As String
    Dim aBundleSplit() As String
    Dim aNumberSplit() As String

    Dim wkbFramework As Workbook
    Dim wkbSaba As Workbook

    Dim shtPlan As Worksheet
    Dim shtCourse As Worksheet

    Dim vData As Variant
    Dim vBundleName As Variant

    Dim lLoop As Long


'set initial values for variables

    'find current row number
        iRow = ActiveCell.Row

    'remember locations of current data
        Set wkbFramework = ActiveWorkbook
        Set shtPlan = ActiveSheet
            'Set rngSelect = Range("B" & iRow)

    'select bundle name
        vBundleName = shtPlan.Range("B" & iRow).Value
        vData = vBundleName
        sBundleName = shtPlan.Range("B" & iRow).Value

    'find and save course names for the bundle
        Sheets(2).Select
        sTxt = Find_Range(vBundleName, Columns("B"), xlValues).Offset(0, 1).Value 'course names from Detail tab
        sTxt2 = Find_Range(vBundleName, Columns("B"), xlValues).Offset(0, 2).Value 'course numbers from Detail tab

    'open new Saba Form
        Workbooks.Add Template:= _
        "C:\Documents and Settings\rookek\Application Data\Microsoft\Templates\Bundle_SabaEntryForm_KM.xltm"

    'remember locations of Saba form
        Set wkbSaba = ActiveWorkbook
        Set shtCourse = ActiveSheet


'move data into new Saba form

'paste bundle name
    wkbSaba.Sheets(shtCourse.Name).Range("B5").Value = vData

'Transfer bundle number
    vData = wkbFramework.Sheets(shtPlan.Name).Range("E" & iRow).Value
    sNumber = vData
    Dim aNumber() As String
    aNumber = Split(sNumber, "-")
    wkbSaba.Sheets(shtCourse.Name).Range("B6").Value = vData


'create  names to use in the bundle description and (later) in naming the file

    'Establish additional variables
        Dim strDate As String
        Dim strName1 As String
        Dim strName2 As String
        Dim strName3 As String
        Dim strName4 As String
        Dim strName5 As String

        Dim aTechSplit() As String
        Dim aCourse() As String

        Dim iTech As Integer
        'Dim iBundle As Integer
        Dim iCourse As Integer


    vData = wkbFramework.Sheets(shtPlan.Name).Range("L" & iRow).Value

    aCourse = Split(sTxt, Chr(10))
    iCourse = UBound(aCourse)
    aTechSplit = Split(vData, " ")
    iTech = UBound(aTechSplit)
    aBundleSplit = Split(sBundleName, " ")
    aNumberSplit = Split(sNumber, "-")
    strName1 = aBundleSplit(0)
    strName2 = aBundleSplit(1)
    If UBound(aNumberSplit) > 1 Then
        strName3 = aNumberSplit(UBound(aNumberSplit) - 1) & aNumberSplit(UBound(aNumberSplit))
    End If
    strName3 = Right(strName3, Len(strName3) - 1)
    strName4 = aTechSplit(0) & " "
    strName5 = aCourse(0)

    For lLoop = 1 To iTech - 1
            strName4 = strName4 & aTechSplit(lLoop) & " "
    Next lLoop

    If iCourse > 1 Then
        For lLoop = 1 To iCourse - 1
                strName5 = strName5 & ", " & aCourse(lLoop)
        Next lLoop
        strName5 = strName5 & ", and " & aCourse(iCourse)
    End If

    If iCourse = 1 Then
        strName5 = strName5 & ", and " & aCourse(iCourse)
    End If

    strName5 = Replace(strName5, " Technical Differences", "")
    strName5 = Replace(strName5, " Overview", "")
    strName5 = Replace(strName5, " Technical Presales for ATCs", "")
    strName5 = Replace(strName5, " Technical Presales for STCs", "")
    strName5 = Replace(strName5, " Technical Presales", "")


'enter base information for Bundle Description
    Dim strBundleDescription As String
    strBundleDescription = "This Knowledge Maintenance bundle covers recent technology changes that may affect " & strName4 & "environments. Topics covered by this bundle include the enhancements and features introduced with " & strName5 & "."
    'wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription

    frmDescriptionReview.CourseDescription = strBundleDescription
    frmDescriptionReview.CourseDescription.MultiLine = True
    frmDescriptionReview.CourseDescription.WordWrap = True
    frmDescriptionReview.Show


'transfer tech and track
    wkbSaba.Sheets(shtCourse.Name).Range("B8").Value = vData


'transfer product GA date
    vData = wkbFramework.Sheets(shtPlan.Name).Range("G" & iRow).Value
    wkbSaba.Sheets(shtCourse.Name).Range("B9").Value = vData


'transfer bundle notification date
    vData = wkbFramework.Sheets(shtPlan.Name).Range("D" & iRow).Value
    wkbSaba.Sheets(shtCourse.Name).Range("B10").Value = vData


'set audience type
    If aNumber(UBound(aNumber)) = "SA" Then
        wkbSaba.Sheets(shtCourse.Name).Range("B11").Value = "Internal, Partner, Customer"
    Else
        wkbSaba.Sheets(shtCourse.Name).Range("B11").Value = "Internal, Partner"
    End If


'set Education Manager
    frmEducationManagerEntry.EducationManagers.MultiLine = True
    frmEducationManagerEntry.EducationManagers.WordWrap = True
    frmEducationManagerEntry.Show


'set EPG
    wkbSaba.Sheets(shtCourse.Name).Range("B13").Value = "N/A (KM course reuse)"


'set Test information to N/A
    wkbSaba.Sheets(shtCourse.Name).Range("A22:B22").Value = "N/A"


'enter course names
    aSplit = Split(sTxt, Chr(10)) 'if there is more than one course, this establishes a number and location for each

    If UBound(aSplit) > 4 Then

        'add rows equal to the difference between ubound and 5
            wkbSaba.Sheets(shtCourse.Name).Range("A21", "B" & 21 + (UBound(aSplit) - 5)).Select
            Selection.EntireRow.Insert

    End If

    For lLoop = 0 To UBound(aSplit)
            wkbSaba.Sheets(shtCourse.Name).Range("B" & 17 + lLoop).Value = aSplit(lLoop)
    Next lLoop


'enter course numbers
    aSplit2 = Split(sTxt2, Chr(10)) 'if there is more than one course, this establishes a number and location for each

    For lLoop = 0 To UBound(aSplit2)
            wkbSaba.Sheets(shtCourse.Name).Range("A" & 17 + lLoop).Value = Trim(aSplit2(lLoop))
    Next lLoop


'save and close Saba form

        With wkbSaba.Sheets(shtCourse.Name)

            Dim SaveAsDialog As FileDialog

            strDate = Date
            strDate = Replace(strDate, "/", ".")

            Set SaveAsDialog = Application.FileDialog(msoFileDialogSaveAs)

            With SaveAsDialog
              .Title = "Choose a file location and file name for your new Saba form"
              .AllowMultiSelect = False
              .InitialFileName = strName1 & strName2 & "_SabaEntryForm_" & strName3 & ".xlsx"
              '.InitialFileName = sSavelocation & "\" & strName3 & "\" & aBundleSplit(0) & aBundleSplit(1) & "_" & strName3 & "_SabaEntryForm" & ".xlsx"
              .Show
              .Execute
            End With

            wkbSaba.Sheets(shtCourse.Name).PrintOut

            wkbSaba.Close

        End With


' Return focus to Plan sheet
    shtPlan.Activate


End Sub

添加属性代码失败

我尝试根据评论中共享的属性链接添加代码，但运行代码会导致编译错误：找不到方法或数据成员。完整的用户表单代码如下所示：

Option Explicit

Private wkbLocation As Workbook
Private shtLocation As Worksheet

Private Sub cmdCancel_Click()

    Unload Me
    End

End Sub

Private Sub cmdOK_Click()

    Dim strValue As String

    strValue = CourseDescription.Value
    If strValue <> "" Then
        wkbLocation.Sheets(shtLocation).Range("B7").Value = strValue
    End If
    Unload Me

End Sub

Property Let MyProp(wkbSaba As Workbook, shtCourse As Worksheet)

    wkbLocation = wkbSaba
    shtLocation = shtCourse

End Property

对用户表单的调用现在看起来像这样：

'enter base information for Bundle Description
    Dim strBundleDescription As String
    strBundleDescription = "This Knowledge Maintenance bundle covers recent technology changes that may affect " & strName4 & "environments. Topics covered by this bundle include the enhancements and features introduced with " & strName5 & "."
    'wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription

    Dim frmDescriptionReview As UserForm3

    Set frmDescriptionReview = New UserForm3
    frmDescriptionReview.MyProp = "Pass to form"
    frmDescriptionReview.CourseDescription = strBundleDescription
    frmDescriptionReview.CourseDescription.MultiLine = True
    frmDescriptionReview.CourseDescription.WordWrap = True
    frmDescriptionReview.Show

运行代码时，出现编译错误：未找到方法或数据成员，突出显示.MyProp. 帮助说这个错误意味着我拼错了对象或成员名称，或者指定了一个超出范围的集合索引。我检查了拼写，MyProp 正是我在两个位置的拼写方式。我不认为我在指定一个集合是吗？没有明确定义。我究竟做错了什么？

4

2 回答 2

0

正如 Reafidy 所说，为用户窗体创建一个属性并将信息传递给它显然是在用户窗体之间传递变量的正确答案。

理想情况下，我想要的是将表单与模块非常松散地耦合，并且根本不接触电子表格（因此，在适当的时候，我可以将信息从其他模块传递给表单，获取返回的信息，并将其放置在适合当前模块（可能位于完全不同的电子表格或完全不同的单元格中）。

我在 PeltierTech 网站 ( http://peltiertech.com/Excel/PropertyProcedures.html ) 上找到了有关使用属性传递数据的其他信息，这些信息帮助我了解了 Reafidy 在做什么，因此我可以开始放松我的代码和表单之间的耦合甚至更多（这是我提出这个问题的初衷。

添加 Get 属性允许我正在寻找的松散耦合，允许我提供和接收信息，而无需传递电子表格数据。所以我在模块中的调用现在看起来像这样：

    'review and revise Description Text
    Dim DescriptionReview As New frmDescriptionReview

    With DescriptionReview
        .Description = strBundleDescription
        .Show
        strBundleDescription = .Description
    End With

    Unload DescriptionReview

'transfer description text
    wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription

并且 UserForm 本身的代码变得更加简单，如下所示：

Option Explicit

Property Let Description(ByVal TextBeingPassed As String)
    Me.CourseDescription.Value = TextBeingPassed
End Property

Property Get Description() As String
    Description = Me.CourseDescription.Value
End Property

Private Sub cmdOK_Click()
    Me.Hide
End Sub

Private Sub cmdCancel_Click()
    Unload Me
    End
End Sub
于 2013-09-20T19:00:44.827 回答
0

我担心在某些（未知）情况下焦点可能会转移到另一个打开的工作表，并且文本将被粘贴到它不属于的地方。

不太确定你在问什么。但是您可以使用以下方法进一步定义您的范围变量：

Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B7").Value = strValue

或者

Workbooks(wkbSaba).Worksheets(shtCourse).Range("B7").Value = strValue

这将确保它进入正确的工作簿和工作表。我不确定你为什么认为你需要公共变量？

编辑：

用户表单代码：

Private wsSheet As Worksheet

Property Let SetWorksheet(wsSheetPass As Worksheet)
    Set wsSheet = wsSheetPass
End Property

Private Sub cmdOK_Click()

    Dim strValue As String

    strValue = CourseDescription.Value
    If strValue <> "" Then
        wsSheet.Range("B7").Value = strValue
    End If
    Unload Me

End Sub

调用模块：

Dim wsSheetToPass As Worksheet

Set wsSheetToPass = Workbooks(wkbSaba).Worksheets(shtCourse)

frmDescriptionReview.SetWorksheet = wsSheetToPass
于 2013-08-20T20:52:34.767 回答