こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBAでユーザーフォーム上に参照したファイルを開きたいのですが…

EXCEL2003 SP3での質問です。
ユーザーフォームをVBAで作成中です。
主な機能は、対象月をコンボBOXで選択させた上で、
データ元とインプット先のファイルをテキストBOXに参照し、
実行ボタンクリックでデータ元からインプット先の該当月シートに
データをコピーするといった感じです。
(データ元の該当シート内データを全てコピー&ペースト)
取り込み以降の処理はVBAを使用せずに作成しようと考えています。

質問は、取込みたいファイルの参照後の「ファイルを開いてデータをコピーする」処理がうまくいかず、
どのようにしたらよいか教えて頂けますでしょうか。

現在、以下のように記述していますが、
CommandButton3_Click()の部分の処理が分からずファイルが開けません。ご教授ください。


Private Sub CommandButton1_Click()
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "テキスト", "*.csv;*.txt", 1
If .Show = 0 Then Exit Sub
Me.TextBox1.Text = .SelectedItems(1)
End With
End Sub

Private Sub CommandButton2_Click()
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "テキスト", "*.csv;*.txt", 1
If .Show = 0 Then Exit Sub
Me.TextBox2.Text = .SelectedItems(1)
End With
End Sub

Private Sub CommandButton3_Click()
Dim file_name As String
If TextBox1.Text = "" Then
MsgBox "ファイルが指定されていません", vbInformation
ElseIf TextBox1.Text = "" Then
file_name = TextBox1.Text = ""
Shell "Workbooks.OpenText TextBox1.Value "
End If
End Sub

Private Sub CommandButton4_Click()
yesno = MsgBox("保存後、ファイルを閉じます。終了していいですか?", vbYesNo + vbQuestion, "Reportの終了")

If yesno = vbYes Then
ActiveWorkbook.Save
ActiveWorkbook.Close
Else
End If
End Sub

投稿日時 - 2008-05-01 14:45:24

QNo.3989864

すぐに回答ほしいです

質問者が選んだベストアンサー

こんばんは。

モジュールレベルの変数をモジュールの一番上に置き、CommandButton3_Clickの中のfile_name 変数の宣言を削除します


ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Range("A1")

インプット先の該当月シートは、
ここの、ActiveSheet の部分を、
ThisWorkbook.Worksheets(shname).Range("A1")
などとして、shname を、別なところで指定してあげる方法があります。

'-------------------------------------
'Option Explicit
Dim file_name

'-----
'省略
'----

Private Sub CommandButton3_Click()
  If TextBox1.Text = "" Then
    MsgBox "ファイルが指定されていません", vbInformation
  Else
    file_name = TextBox1.Text
    Workbooks.OpenText file_name
    'シートへのコピー
    ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Range("A1")
  End If
End Sub

Private Sub CommandButton4_Click()
  Dim yesno As VbMsgBoxResult
  Dim fn As String
  'モジュールレベル変数のチェック
  If file_name <> "" Then
    fn = Mid$(file_name, InStrRev(file_name, "\") + 1)
    yesno = MsgBox("保存後、ファイルを閉じます。終了していいですか?", _
    vbYesNo + vbQuestion, "Reportの終了")
    If yesno = vbYes Then
      On Error Resume Next
      'テキストボックスを保存して閉じる
      'UserForm上から、ThisWorkbook.Close は、ファイル・トラブルの元ですから、そのまま、終了はしてはいけません。
      Workbooks(fn).Close True
      On Error Goto 0
      file_name = ""
    End If
  End If
End Sub

投稿日時 - 2008-05-01 19:42:21

お礼

返答が遅くなり申し訳ありません。
非常に分かりやすくご説明いただき、ありがとうございました。
VBAは奥が深くて分からない事だらけです。
UserForm上から、ThisWorkbook.Closeが
ファイル・トラブルの元という事も初めて知りました。

一応、下記のように対応してみました。
今後、データの置換など細かな設定を行っていきます。

Private Sub CommandButton3_Click()
If TextBox1.Text = "" Then
MsgBox "ファイルが指定されていません", vbInformation
Else
file_name = TextBox1.Text
Workbooks.OpenText file_name
'シートへのコピー
ActiveSheet.Cells.Copy
End If
Workbooks.OpenText TextBox2.Value 'Excelで開く
With UserForm1
Select Case UserForm1.ComboBox1.ListIndex
Case 0
Worksheets("1月").Activate
Case 1
Worksheets("2月").Activate
Case 2
Worksheets("3月").Activate
Case 3
Worksheets("4月").Activate
Case 4
Worksheets("5月").Activate
Case 5
Worksheets("6月").Activate
Case 6
Worksheets("7月").Activate
Case 7
Worksheets("8月").Activate
Case 8
Worksheets("9月").Activate
Case 9
Worksheets("10月").Activate
Case 10
Worksheets("11月").Activate
Case 11
Worksheets("12月").Activate
ThisWorkbook.ActiveSheet.Cells.Select
End Select
ActiveSheet.Paste
End With
End Sub

投稿日時 - 2008-05-07 11:35:33

ANo.1

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

こんばんは。

>今後、データの置換など細かな設定を行っていきます。

まだ、最終ではありませんよね。

TextBox1 で開け、もうひとつ、TextBox2 も開けて、それを順次、コピーしていくのでしょうか。

Workbooks.OpenText TextBox2.Value 'Excelで開く
' この下の部分も、TextBox1 のところと同じように働くわけですか?

とはいえ、難しいことしていますね。(^^ゞ

そこで、考え方は違うかもしれませんが、例えば、今の状態だと、何かいきなりという感じで、マクロが進んでしまうような気がします。ListBox の選択をうっかり忘れていることなんてありませんか。ボタンを押したら、あっという間に、コピーされてしまいます。

ファイル名がテキストボックスに入って、リストボックスが選択されたのを確認したら、後は、一気に、「同じシート」にインポートというようにします。いくつか、テクニックが入っていますから、解説があるので、何か折に利用してみてください。

---------------------------------------

Private Sub CommandButton3_Click()
  Dim mon As Variant
  Dim i As Integer
  Dim j As Integer
  Dim iflg As Variant
  Dim file_name As String
  Dim n As Long
  Dim rng As Range
  For i = 1 To 2 'Controls でループ
    If Me.Controls("TextBox" & i).Text <> "" Then
      iflg = 1 + iflg
    End If
  Next i
  If iflg < 2 Then 'テキストボックスの数
    MsgBox "TextBox 両方にファイル名を入れてください。"
    Exit Sub
  End If
  'リストボックスが選択されているかチェック
  If Me.ListBox1.ListIndex > -1 Then
    Application.Goto ThisWorkbook.Worksheets(Me.ListBox1.Value).Range("A1") 'ブックをActivate せずにJump
    If MsgBox(Me.ListBox1.Value & " のシートでよろしいですか?", vbQuestion + vbOKCancel) = vbCancel Then
      Exit Sub
    End If
  Else
    MsgBox "ListBox を選択してください。", vbInformation
    Exit Sub
  End If
  'テキストボックスのファイル名をひとつずつ処理
  For j = 1 To 2
    file_name = Me.Controls("TextBox" & j).Text
    With ThisWorkbook.Worksheets(Me.ListBox1.Value)
      If rng Is Nothing Then
        Set rng = .Range("A1")
      Else
        '二度目に開いたときの最終行を探す
        With ActiveSheet.UsedRange
          n = .Cells(.Cells.Count).Row
          Set rng = .Cells(n + 1, 1)
        End With
      End If
    End With
    On Error Resume Next
    Workbooks.OpenText file_name
    '選択したシートに貼り付け
    With ActiveWorkbook
      .ActiveSheet.UsedRange.Copy rng
      .Close False 'テキストファイルは保存せずに終わる
    End With
  Next j
  On Error Goto 0
  Application.Goto ThisWorkbook.Worksheets(Me.ListBox1.Value).Range("A1")
  Set rng = Nothing
End Sub

投稿日時 - 2008-05-07 19:48:07

お礼

アドバイスありがとうございます。

現状、下記のような形で考えております。
CommandButton1:レポート対象月のシート選択
CommandButton2:比較対象月のシート選択
TextBox1:予めWEBからエクスポートしたCSVファイルを選択
TextBox2:加工後のCSVファイルのデータをコピーするファイルを選択
CommandButton3:TextBox1で選択したファイルを加工(不要なデータ削除やソート)、
TextBox2で選択したファイルのCommandButton1で選択したシートに貼付け…といった流れです。

いろいろ考える中で自分で複雑にしているのかもしれません。
一度、自分の中でも整理してみます。

投稿日時 - 2008-05-07 22:00:32

あなたにオススメの質問