0

新しいスプレッドシートの一部になる前に、マクロで生成された文字列を変更できるユーザーフォームを作成しました。書かれているように、私はそれがどれほど回復力があるかについて1つの心配があります。

CourseDescriptionフォームには、文字列値strBundleDescriptionがダンプされる単一のテキスト ボックスが呼び出されます。

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

ユーザーは、必要に応じてテキストを編集し、[OK] を押して、作成中のスプレッドシートにテキストを渡すことができます。

[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

私が見つけたすべての潜在的な解決策には、何らかの形式のパブリック変数が含まれていましたが、原則として (正しいか間違っているかを問わず)、情報が 1 つの関数でのみ使用される場合 (この場合のように)、パブリック変数を回避しようとしています。


要求された完全なコード:これはそのままの完全なマクロ コードです。の呼び出しfrmDescriptionReviewは、コメント タグ「'enter base information for 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

プロパティ コードの追加に失敗する

コメントで共有されているプロパティ リンクに基づいてコードを追加しようとしましたが、コードを実行するとコンパイル エラーが発生します: メソッドまたはデータ メンバーが見つかりません。完全なユーザーフォーム コードは次のようになります。

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 の Web サイト ( 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 に答える