Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


5882 / 13645 ツリー ←次へ | 前へ→

【48395】条件にあったファイルを開き、処理後閉じるには tamachan 07/4/16(月) 11:49 質問[未読]
【48398】Re:条件にあったファイルを開き、処理後閉... ウッシ 07/4/16(月) 12:17 発言[未読]
【48399】Re:条件にあったファイルを開き、処理後閉... Kein 07/4/16(月) 12:41 回答[未読]
【48411】Re:条件にあったファイルを開き、処理後閉... tamachan 07/4/16(月) 19:04 お礼[未読]

【48395】条件にあったファイルを開き、処理後閉じ...
質問  tamachan  - 07/4/16(月) 11:49 -

引用なし
パスワード
   ブック(A)のマクロでから条件に合う別のフォルダ内にある
ブックを開くようにしました。開いたブック(仮にブック(B))のデータを
オートフィルターで抽出して、ブック(A)の指定セルに貼付けた後
ブック(B)を閉じてブック(A)の処理を継続させたいのですが、
ブック(B)は、ブック(A)の条件により開きますので、ファイル名が違います。
この場合、ブック(B)を閉じる処理はどのようにしたらよいでしょうか。

VBAで以下のように組んでますが、閉じ方がわかりませんので、教えてください。

ブック名 = ActiveWorkbook.Name        'ブック(A) です。
    Worksheets("メイン").Select
    Cells(4, 7) = ブック名 'ブック名を表示
    
    Range("G3:G4").Select       
    Selection.Copy
Application.Run "A06支払月報ファイル検索"  'ブック(B)を開きます。 
    Worksheets("メイン").Select
    Range("G3:G4").Select         
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

   '-------- いくつかの処理を行って -------
Sheets("現場データ").Select
  Range("A1").PasteSpecial Paste:=xlValues
  下 = Range(Cells(1, 1), Cells(1, 1)).End(xlDown).Row
  右 = Range(Cells(1, 1), Cells(1, 1)).End(xlToRight).Column     Range(Cells(2, 1), Cells(下, 右)).Copy
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Selection.Copy
  
  Dim awb As String
    awb = Worksheets("メイン").Cells(4, 7).Value
    Workbooks(awb).Activate        'ブック(A)をアクティブ
  ActiveWindow.WindowState = xlNormal
  Application.Run "A02月報入力シートオープン"
  Range("J15").PasteSpecial Paste:=xlValues  '貼付け

'-----この後、ブック(B) を閉じて、ブック(A)の処理を続けたいのですが?---


'参考 Application.Run "A06支払月報ファイル検索"の内容です。
Sub A06支払月報ファイル検索()
  
  Application.ScreenUpdating = False
  Sheets("メイン").Select
  
  If Range("C1") = 1 Then          
    ChDir "X:\_売上報告関連\支払月報"
    Workbooks.Open Filename:="X:\_売上報告関連\支払月報\09月支払月報.xls"
  ElseIf Range("C1") = 2 Then        
    ChDir "X:\_売上報告関連\支払月報"
    Workbooks.Open Filename:="X:\_売上報告関連\支払月報\10月支払月報.xls"
  ElseIf Range("C1") = 3 Then        
    ChDir "X:\_売上報告関連\支払月報"
    Workbooks.Open Filename:="X:\_売上報告関連\支払月報\11月支払月報.xls"
  ElseIf Range("C1") = 4 Then        
    ChDir "X:\_売上報告関連\支払月報"
    Workbooks.Open Filename:="X:\_売上報告関連\支払月報\12月支払月報.xls"
  ElseIf Range("C1") = 5 Then        
    ChDir "X:\_売上報告関連\支払月報"
    Workbooks.Open Filename:="X:\_売上報告関連\支払月報\01月支払月報.xls"
  ElseIf Range("C1") = 6 Then        
    ChDir "X:\_売上報告関連\支払月報"
    Workbooks.Open Filename:="X:\_売上報告関連\支払月報\02月支払月報.xls"
    Else                    
    
  End If
End Sub

【48398】Re:条件にあったファイルを開き、処理後...
発言  ウッシ  - 07/4/16(月) 12:17 -

引用なし
パスワード
   こんにちは

  Dim wb As Workbook

  Set wb = Workbooks.Open(Filename:="X:\〜\B1.xls")
  wb.Save
  wb.Close

  Set wb = Workbooks.Open(Filename:="X:\〜\B2.xls")
  wb.Save
  wb.Close

のようにして同じオブジェクト変数を使い回してはどうでしょうか?

【48399】Re:条件にあったファイルを開き、処理後...
回答  Kein  - 07/4/16(月) 12:41 -

引用なし
パスワード
   >ブック(B)を閉じる
いくつかの方法が考えられますが、ブック(B)を開いた時点で、Workbook型の
グローバル変数に格納しておき、それを使って閉じる。というのが分かりやすい
と思います。モジュールの先頭に

Private MyBook As Workbook

と宣言し、Sub A06支払月報ファイル検索() で

  End If
  Set MyBook = ActiveWorkbook '←このコードを追加する
End Sub

>ブック(B) を閉じて
の部分は

If Not MyBook Is Nothing Then
  MyBook.Close False
  Set MyBook = Nothing
End If

などとします。でももっと簡単な方法は、プロシージャを分割しないで
一つにまとめてしまうことでしょうね。そうすれば MyBook も宣言せずに
ActiveWorkbook.Close False とするだけで済みそうですし、いくらか処理も速く
なります。ちなみに Sub A06支払月報ファイル検索() のコードの書き方は

Sub A06支払月報ファイル検索()
  Dim MyNum As Integer
  Dim MyF As String
  Const Fol As String = "X:\_売上報告関連\支払月報\"

  On Error GoTo ELine
  MyNum = Worksheets("メイン").Range("C1").Value
  If MyNum > 0 And MyNum < 7 Then
   MyF = Format(MyNum + 8, "00") & "月支払月報.xls"
   Workbooks.Open Fol & MyF
   Set MyBook = ActiveWorkbook
  End If
ELine:
End Sub

などとすれば、うまくまとまると思います。

【48411】Re:条件にあったファイルを開き、処理後...
お礼  tamachan  - 07/4/16(月) 19:04 -

引用なし
パスワード
   ▼Kein さん:
ありがとうございました。
おかげさまでうまく処理ができました。

お手数ですが、もしよろしければ、ピボットテーブルについて
教えていただきたいのですが、
1.アクセスのクエリで抽出したデータをExcelに展開し、
ファイルを作成。>外部加工費のファイル名で保存。
2.外部加工費のファイルの外部加工費SheetをCopyして
3.加工費月報の"Access"Sheetに値で貼り付けた後、
4.ピボットテーブルを作成してこのデータを"加工_集計"Sheetに
 値で貼り付けるようにしようと考え、以下のように
 コマンドを記述したのですが、
  実行時エラー'1004'
  そのピボットテーブルのフィールド名は正しくありません。
  ----------
  と表示されうまく動作しません。
  お時間がございましたら教えてください。

Option Explicit
    Dim データ As String        'データベースのシート名
    Dim ピボット As String       'ピボットテーブルのシート名
    Dim ブック名 As String       'このブックの名前
    Private ソース As String      'ソースデータの範囲
    Private テーブル先 As String    'ピボットテーブル作成先
    Private テーブル名 As String    'ピボットテーブルの名前
    Private 下端 As Integer       '下端の行数
Sub KD01_Accessよりデータ作成()
'
' D01データ作成 Macro
' マクロ記録日 : 2007/4/11 ユーザー名 : FHaraguchi
'

'
  Application.ScreenUpdating = False
  
  Sheets("Access").Select
    Cells.Select
    Selection.Clear
  
  Workbooks.Open Filename:="X:\_売上報告関連\外注加工集計.xls"
  Cells.Select
  Selection.Copy
  Windows("01月加工費支払月報.xls").Activate
  Sheets("Access").Select
  Range("A1").PasteSpecial Paste:=xlValues
  ピボットテーブルを作成する
  ActiveWorkbook.ShowPivotTableFieldList = True
  ActiveWorkbook.ShowPivotTableFieldList = False
  Application.CommandBars("PivotTable").Visible = False
 
 
  Sheets("加工_集計").Select
  
  Cells.Select
  Selection.Clear
  Sheets("ピボット").Select
  Cells.Select
  Selection.Copy
  Sheets("加工_集計").Select
   Range("A1").PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    Rows("1:1").Select             '1行目削除
    Selection.Delete Shift:=xlUp
    
  Windows("外注加工集計.xls").Activate
  ActiveWindow.Close
  Windows("01月加工費支払月報.xls").Activate
  Sheets("メイン").Select
  Range("H30").Select
  Range("H30") = "外注加工費の取込が完了しました。"
End Sub
Private Sub ピボットテーブルを作成する()
  
    ブック名 = ActiveWorkbook.Name       'このブックの名前
    データ = "Access"               '※2 データベースのシート名
    ピボット = "ピボット"
  Sheets(ピボット).Select
    Cells.Select
    Selection.Clear        'すべてクリア
  
  Sheets(データ).Select
    下端 = Range(Cells(1, 1), Cells(1, 1)).End(xlDown).Row '下端検出
    Range("A1").Select
    
    ソース = データ & "!R1C1:R" & 下端   '
    テーブル先 = "[" & ブック名 & "]" & ピボット & "!R1C1"
    テーブル名 = "加工費"
    ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _
      ソース, TableDestination:=テーブル先, TableName:=テーブル名
    ActiveSheet.PivotTables(テーブル名).AddFields RowFields:="元請名", _
      ColumnFields:="作業員1"
    ActiveSheet.PivotTables(テーブル名).PivotFields("合計 の 合計の合計").Orientation _
      = xlDataField
End Sub

5882 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free