5 つのワークブックからの情報を、メイン ワークブックの指定されたワークシートにインポート、コピー、および貼り付けるための次の手順を作成しました。インポートしたファイルをコピーして正しいシートに貼り付けることが非常に重要です。そうしないと、プロジェクト全体の計算が失敗します。
インポートするファイルが指定されたパスに見つからない場合、ファイルを開くダイアログが開き、ユーザーがファイルを参照できるように手順が記述されています。ファイルが見つかると、プロシージャはそのファイルをメイン ワークブックにインポートします。
すべて正常に動作しますが、ファイルが見つからず、ユーザーがディレクトリ内のファイル名を確認すると、そのファイルが取り込まれ、ワークブックに貼り付けられることに気付きました。これは問題であり、ユーザーが間違ったファイルをインポートするのを防止または警告する方法がわかりません。
言い換えれば、私のループは、For n As Long = 1 to 5 Step 1 不足しているファイルがあり、ファイルをn=3 or statusReport.xls開くダイアログが開いている場合、ユーザーはそのディレクトリまたはその他のファイルを選択して、指定されたシートに貼り付けることができます。私が欲しいのは、等しくないファイルを選択したことをユーザーに警告することですn=3 or statusReport.xls
インポートする 5 つのワークシートと貼り付けるシートの関数は次のとおりです。
Public Function DataSheets(Index As Long) As Excel.Worksheet
'This function indexes both the data employee and position
'export sheets from Payscale.
'@param DataSheets, are the sheets to index
Select Case Index
Case 1 : Return xlWSEmployee
Case 2 : Return xlWSPosition
Case 3 : Return xlWSStatusReport
Case 4 : Return xlWSByDepartment
Case 5 : Return xlWSByBand
End Select
Throw New ArgumentOutOfRangeException("Index")
End Function
Public Function GetImportFiles(Index As Long) As String
'This function houses the 5 files
'used to import data to the project
'@param GetImportFiles, are the files to be
'imported and pasted on the DataSheets
Select Case Index
Case 1 : Return "byEmployee.csv"
Case 2 : Return "byPosition.csv"
Case 3 : Return "statusReport.xls"
Case 4 : Return "byDepartment.csv"
Case 5 : Return "byband.csv"
End Select
Throw New ArgumentOutOfRangeException("Index")
End Function
ファイルをインポート、コピー、ペーストする手順です。私自身の正気と、何が起こっているのかを理解しようとしている人々のために、多くのコメントが寄せられています. また、選択したファイルが等しいことを確認するためにチェックを挿入する必要がある場所を以下に示しましたn
'This procedure imports the Client Listing.xlsx sheet. The procedure checks if the file is
'in the same directory as the template. If the file is not there, a browser window appears to allow the user
'to browse for the missing file. A series of message boxes guide the user through the process and
'verifies that the user picked the right file. The user can cancel the import at any time.
'Worksheet and Workbook Variables
Dim xlDestSheet As Excel.Worksheet
Dim xlWBPath As String = Globals.ThisWorkbook.Application.ActiveWorkbook.Path
Dim strImportFile As String
Dim xlWBSource As Object = Nothing
Dim xlWBImport As Object = Nothing
'Loop through the 5 sheets and files
For n As Long = 1 To 5 Step 1
strImportFile = xlWBPath & "\" & GetImportFiles(n)
xlDestSheet = DataSheets(n)
'Convert the indexed sheet name to a string
'so that it can be passed through the xlWB.Worksheets paramater
Dim strDestSheetName As String = xlDestSheet.Name
'If the file is found, then import, copy and paste the
'data into the corresponding sheets
If Len(Dir(strImportFile)) > 0 Then
xlWBSource = Globals.ThisWorkbook.Application.ActiveWorkbook
xlWBImport = Globals.ThisWorkbook.Application.Workbooks.Open(strImportFile)
xlWBImport.Worksheets(1).Cells.Copy(xlWB.Worksheets(strDestSheetName).Range("A1"))
xlWBImport.Close()
Else
'If a sheet is missing, prompt the user if they
'want to browse for the file.
'Messagbox variables
Dim msbProceed As MsgBoxResult
Dim strVmbProceedResults As String = ("Procedure Canceled. Your project will now close")
Dim strPrompt As String = " source file does not exist." & vbNewLine & _
"Press OK to browse for the file or Cancel to quit"
'If the user does not want to browse, then close the workbook, no changes saved.
msbProceed = MsgBox("The " & strImportFile & strPrompt, MsgBoxStyle.OkCancel + MsgBoxStyle.Question, "Verify Source File")
If msbProceed = MsgBoxResult.Cancel Then
msbProceed = MsgBox(strVmbProceedResults, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical)
xlWB.Close(SaveChanges:=False)
Exit Sub
Else
'If the user does want to browse, then open the File Dialog
'box for the user to browse for the file
'Open Fil Dialog box variable and settings
Dim ofdGetOpenFileName As New OpenFileDialog()
ofdGetOpenFileName.Title = "Open File " & strImportFile
ofdGetOpenFileName.InitialDirectory = xlWBPath
ofdGetOpenFileName.Filter = "Excel Files (*.xls;*.xlsx; *.xlsm; *.csv)| *.xls; *.csv; *.xlsx; *.xlsm"
ofdGetOpenFileName.FilterIndex = 2
ofdGetOpenFileName.RestoreDirectory = True
'If the user presses Cancel on the box, warn that no
'file has been selected and the workbook will close
If ofdGetOpenFileName.ShowDialog() = System.Windows.Forms.DialogResult.Cancel Then
'Message box variables
Dim msbContinue As MsgBoxResult
Dim strAlert As String = ("You have not selected a workbook." & vbNewLine & _
"The project will now close without saving changes")
'Once the user presses OK, close the file and do not save changes
msbContinue = MsgBox(strAlert, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "No Workbook Seletected")
xlWB.Close(SaveChanges:=False)
Exit Sub
Else
'If the user does select the file, then import the file
'copy and paste on workbook.
'***Here is where I need to check that strImportFile =n, if it does not warn the user******
strImportFile = ofdGetOpenFileName.FileName
xlWBImport = Globals.ThisWorkbook.Application.Workbooks.Open(strImportFile)
xlWBImport.Worksheets(1).Cells.Copy(xlWB.Worksheets(strDestSheetName).Range("A1"))
xlWBImport.Close()
End If
Try
'Import the remainder of the files
xlWBSource = Globals.ThisWorkbook.Application.ActiveWorkbook
xlWBImport = Globals.ThisWorkbook.Application.Workbooks.Open(strImportFile)
xlWBImport.Worksheets(1).Cells.Copy(xlWB.Worksheets(strDestSheetName).Range("A1"))
xlWBImport.Close()
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Unexpected Error")
End Try
End If
End If
Next
End Sub
私のコードを改善するための助けやアドバイスをいただければ幸いです。
ありがとうございました。