|
▼Ib(初心者) さん:
こんにちは
回答の前段階として。
アップされたコードを、そのまま【インデント】をつけて書きますと以下になります。
Sub 円楕円2_Click()
Dim strFileName As String
Dim セル内容, パス名 As String
' オープンするCSVファイルのフォルダを C:\ として
' ファイルオープンのダイアログを開く
ChDir ("C:\")
strFileName = Application.GetOpenFilename("CSVファイル (*.CSV),*.CSV", 1, "ファイルを選択")
If (strFileName <> "False") Then
' ファイル名が存在しない場合は抜ける
If (Trim(Dir(strFileName)) = "") Then
Call MsgBox("ファイルが見つかりません", vbOKOnly, "確認")
Else
'
' コピー先の範囲をクリア
ThisWorkbook.Worksheets("データ入力場所").Range("A3:R273").ClearContents
' 該当CSVファイルを新規BOOKとして読込んで開く
'
' コピーペースト
Workbooks.Open Filename:=strFileName
ActiveSheet.Range("A1:R272").Copy _
Destination:=ThisWorkbook.Worksheets("データ入力場所").Range("A3")
' コピー後、CSVファイルを閉じる
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End If
End If
' book新規保存
セル内容 = Range("B4").Value ' アクティブセルの内容をファイル名として保存。
If セル内容 = "" Then Exit Sub
パス名 = "C:\Users" ' 保存場所
ActiveWorkbook.SaveAs Filename:=パス名 & "\" & セル内容 & ".xlsm"
End Sub
●最後の新規保存のところですが、キャンセルボタンをおされた時にも実行されますね。
また、ファイルが存在しないときも(後述しますが、このケースはありません)コード上は
実行されることになっていますね。
●GetOpenFileName ダイアログでは、確かに、ファイル名を操作者が変更することはできますが
存在しないファイル名だった場合 GetOpenFileName ダイアログ内でエラーで拒否されますので
実際には、存在するファイル名のみが取得されます。ですから DIRでの存在チェックは不要です。
|
|