将信息从宏传递到userform到工作表时的范围约束和变量管理

时间:2013-08-20 19:55:50

标签: excel-vba excel-2010 vba excel

我已经构建了一个userform,允许在宏生成的字符串成为新电子表格的一部分之前对其进行修改。如上所述,我担心它会有多么弹性。

表单有一个名为CourseDescription的文本框,其中转换了字符串值strBundleDescription

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

然后,用户可以根据需要编辑文本,然后按“确定”将文本传递给正在创建的电子表格。

单击“确定”后,修改后的字符串将放在电子表格的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

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

我的问题:我是否有权想要一个更明确的位置,或者像上面那样的简单范围定义是否足够?如果建议定义更明确的位置,是否可以在不创建公共变量的情况下传递wkbSabashtCourse值等信息?

我发现的所有可能的解决方案都涉及某种形式的公共变量,但原则上(正确或错误)我试图避免公共变量,因为信息只会在一个函数中使用(如本例所示)。


完整代码,按要求:这是完整的宏代码。 frmDescriptionReview的调用大约是注释标记“'输入Bundle Description的基本信息”下的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

添加属性代码失败

我尝试根据注释中共享的属性链接添加代码,但运行代码会导致编译错误:找不到方法或数据成员。完整的userform代码如下所示:

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

现在,对userform的调用如下所示:

'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

当我运行代码时,出现Compile错误:找不到方法或数据成员,突出显示.MyProp。帮助说这个错误意味着我拼错了对象或成员名称,或者指定了超出范围的集合索引。我检查了拼写,MyProp正是我在两个地方拼写的方式。我不认为我是在指定收藏品吗?没有明确定义。我做错了什么?

2 个答案:

答案 0 :(得分:0)

  

我担心焦点可能出现在某些(未知)环境中   转移到另一个打开的工作表,文本将被粘贴到它   不属于。

不确定你在问什么。但您可以使用以下命令进一步定义范围变量:

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

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

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

编辑:

UserForm代码:

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

答案 1 :(得分:0)

正如Reafidy所述,为Userform创建一个属性并将信息传递给它显然是将变量传入和传出userform的正确答案。

理想情况下,我想要的是将表单与模块完全混合在一起,而不是触摸电子表格(因此,在适当的时候,我可以将信息从其他模块传递到表单,获取返回的信息,并将其放在哪里适用于当前模块(可以在完全不同的电子表格或完全不同的单元格中)。

我在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