新しいスプレッドシートの一部になる前に、マクロで生成された文字列を変更できるユーザーフォームを作成しました。書かれているように、私はそれがどれほど回復力があるかについて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 は両方の場所で正確にスペルを変更しました。コレクションを指定しているとは思いませんか?明示的に定義されているものはありません。私は何を間違っていますか?