• ベストアンサー
  • 困ってます

VBAについて質問です。

VBAについて質問です。 現在、ExcelにてWorkbookを自動で作成するモジュールを作成しています。 モジュールを記載しているWorkbookを [wbSorce] 自動で作成されるWorkbookを [wbNew] とします。 [wbSorce] でモジュールを実行すると、 [wbNew] を新規に作成し、 データを入力して保存するのですが、保存する際に [wbNew] のイベントハンドラ [Workbook_Open] に 保存された [wbNew] を開いた時の挙動を記載するには どうすればよいでしょうか? サンプルは下記になります。 ****[wbSorce]のモジュール**** Sub wbNew_Sakusei()   Dim wb As Workbook   Dim wb2 As Workbook   Dim i As Integer   Set wb = ThisWorkbook   Set wb2 = Workbooks.Add   For i = 1 To 5     wb2.Sheets(1).Cells(1, i) = wb.Sheets(1).Cells(1, i)   Next   wb2.SaveAs Filename:="wbNew" End Sub ****[wbNew]に記述したいモジュール**** Private Sub Workbook_Open()   ActiveWindow.ScrollRow = 1   MsgBox "Workbook_Openイベントが発生しました。" End Sub

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数85
  • ありがとう数2

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

  • ベストアンサー
  • 回答No.1

"C:\temp\Macro.txt"に、****[wbNew]に記述したいモジュール****の内容を記述しておいてください。 Sub wbNew_Sakusei() Dim wb As Workbook Dim wb2 As Workbook Dim i As Integer Set wb = ThisWorkbook Set wb2 = Workbooks.Add For i = 1 To 5 wb2.Sheets(1).Cells(1, i) = wb.Sheets(1).Cells(1, i) Next With wb2.VBProject .VBComponents("ThisWorkbook").CodeModule.AddFromFile "C:\temp\Macro.txt" End With wb2.SaveAs Filename:="wbNew" End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご記入頂いたソースで実行、無事期待通りの結果が出力されました。 後学の為、頂いたソースで検索して処理も理解出来ました。 なるほど!と目からウロコがこぼれた気分です。 本当にありがとうございました。

関連するQ&A

  • VBA VLOOKUP 別のファイルを参照

    VBA VLOOKUP 別のファイルを参照 いつもこちらでお世話になっている者です。 VBAの勉強をしております。 別のファイルからVLOOKUPで値を参照したいのですが、 範囲を指定してみましたが、 「worksheetFunctionクラスのVlookupプロパティを参照できません」 とのメッセージが出てしまいます。 なお、値は空白になる行もありますので、 if関数で回避してみましたがうまくいきません。 いろいろ試しましたが、何度やってもうまくいかないので こちらに質問させていただきました。 お詳しい方、ご伝授いただければ助かります。 よろしくお願い致します。 環境はExcel2007です。 Sub sample() Dim 範囲 As Range Dim wb As Workbook, wb2 As Workbook Dim r As Integer,intRow As Integer Workbooks.Open Filename:="***.xlsm" Set wb = ThisWorkbook Set wb2 = ActiveWorkbook Set 範囲 = wb2.Sheets("PvtSht2").Range("Database3") r = wb.Sheets("sheet1").Range("A28:N28").End(xlToRight).ColumnintRow = 3 With wb.Sheets("sheet1") Do Until .Cells(intRow, 1).Value = "" .Cells(intRow, (r + 1)) = Application.WorksheetFunction.If((Application.WorksheetFunction.VLookup(Cells(intRow, 1), 範囲, 2, False)) = 0, "", Application.WorksheetFunction.VLookup(Cells(intRow, 1), 範囲, 2, False)) intRow = intRow + 1 Loop End With End sub

  • エクセルVBA 3/26夜の補足です

    おはようございます お忙しいに申し訳ありません 春から私用で使うための自作ソフトを作成したおります ご迷惑おかけします 指摘のサンプルです わたしなりに作成したものです Sub sheetcopy1() ThisWorkbook.Sheets("sheet1").Select Range("B2:K100").Select Selection.Copy Dim wb As Workbook Set wb = Workbooks.Add ThisWorkbook.Sheets("sheet1").Copy before:= _ wb.Worksheets(1) Set wb = Nothing End Sub これですと、新しいBOOKが起動しシートすべての項目が張り付きます シートの一部を(B2からK100)を移したいと思っています ワンクリックとはフォームのコマンドボタンで移動できればと思っています よろしければお知恵をおかりしたくおもいます よろしくお願いします

  • エクセルVBAで作成した別ブックにVBAを記述したい

    VBAで別ファイルの作成は下記で出来ているのですが、出来上がったファイルにVBAを記述する方法がわかりません。 具体的には一番下のSub TEST()を新しいブックの標準モジュールに記述したいのと、sheet1に Private Sub Worksheet_Change(ByVal Target As Range) MsgBox "ChangeTEST" End Sub を入れたいです。 また Private Sub Workbook_Open() MsgBox "OpenTEST" End Sub も入れたいのです。 どうぞご教示ください。 Sub 複製() Dim wb As Workbook, sc As Integer sc = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Set wb = Workbooks.Add Application.SheetsInNewWorkbook = sc wb.Sheets("Sheet1").Select ThisWorkbook.Sheets("Sheet1").Cells.Copy wb.Sheets("Sheet1").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Buttons.Add(123, 195, 68.25, 15).Select Selection.OnAction = "TEST" Selection.Characters.Text = "TEST" ActiveWorkbook.Close ThisWorkbook.Activate Sheets("Sheet1").Select End Sub Sub TEST() MsgBox "TEST!!" End Sub よろしくお願いします。

  • エクセルVBAでBOOKを開く際の処理

    エクセルVBAでBOOKを開く際の処理 エクセル2000です。 VBAで特定のフォルダー内のBOOKを開き、1枚目のシートSheets(1)のデータを読み込んで別BOOK(マクロを記載したBOOK)にコピペしたら保存せず閉じるコードを下記のように書きました。(かなり簡略化しましたが) これで作動するのですが、万一、そのフォルダー内のBOOKが開いていても1枚目のシートのデータを読み込み後、閉じられてしまいます。 BOOKが開いていれば、その開いていたBOOKは閉じず、先に進むようにするにはどのように直せばいいでしょうか? Sub TEST01()   Dim mb As Workbook, wb As Workbook   Dim myfd As String, fnme As String, ans As Byte, i As Long      ans = MsgBox("集計用フォルダーには回収したアンケートファイルとこの集計用ファイルしかないですね?", vbYesNo + vbQuestion, "( ̄∇ ̄) ? ")   If ans = vbNo Then     MsgBox "それじゃだめです。", vbCritical, "Σ( ̄ロ ̄lll)"     Exit Sub   End If      Set mb = ThisWorkbook   myfd = mb.Path   fnme = Dir(myfd & "\*.xls")      Do Until fnme = Empty     If fnme <> mb.Name Then       Set wb = Workbooks.Open(myfd & "\" & fnme)       i = i + 1       mb.Sheets(1).Cells(i, 1) = wb.Sheets(1).Range("S10")       wb.Close (False) '保存せずに閉じる     End If     fnme = Dir   Loop        Set mb = Nothing   Set wb = Nothing   MsgBox i End Sub

  • Excel 2007 マクロ 別ブックのシートをコピーする方法

    Excel 2007 マクロ 別ブックのシートをコピーする方法 別ブックのシートをコピーして アクティブなブックのシートにコピーしたいと思います。 下記マクロを作成しました。 貼り付ける際に、クリップボードに保存するかどうか 聞かれるメッセージが表示されてうまくいきません。 またもっとシンプルな書き方があればアドバイスお願いします。 Sub 取り込み() Dim wb As Workbook Set wb = Workbooks.Open("\") Sheets("Sheet1").Select Cells.Select Selection.Copy ThisWorkbook.Activate ThisWorkbook.Sheets("特定").Select ActiveSheet.Cells(1, 1).Select ActiveSheet.Paste wb.Close End Sub

  • エクセルVBAでBOOKに読み取りパスワード設定

    エクセル2013です。 以下のコードで指定した任意のフォルダ内のエクセルに読み取りパスワードを設定できました。 しかし、そのフォルダの下にサブフォルダーがあった場合にサブフォルダ内のBOOKは対象になりません。どのように直せばサブフォルダも対象にできるようになるでしょうか?教えてください。 Sub TEST01()   Dim myfdr As String, fname As String   Dim mb As Workbook, wb As Workbook   Dim n As Long   With Application.FileDialog(msoFileDialogFolderPicker) '対象とするフォルダの指定      If .Show = True Then       myfdr = .SelectedItems(1)     Else       MsgBox "キャンセルします。"       Exit Sub     End If   End With   Set mb = ThisWorkbook 'このコピー先ブックをmbとする。   fname = Dir(myfdr & "\*.xls*") 'フォルダ内のExcelブックを検索   n = 2   Do Until fname = Empty '全て検索     Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。     With mb.Sheets("Sheet1") '転記       .Cells(n, "B").Value = wb.FullName       .Cells(n, "C").Value = wb.Sheets(1).Range("B1").Value     End With     n = n + 1 'カウント     Application.DisplayAlerts = False     wb.SaveAs Filename:=wb.FullName, Password:="emaxemax"     wb.Close     Application.DisplayAlerts = True     fname = Dir 'フォルダ内の次のExcelブックを検索   Loop '繰り返す   MsgBox n - 2 & "件処理しましました。" End Sub

  • VBAで Set wb = Sheets(1).Copyができないわけ?

    つい先ほどの質問 4150169 は掲示したコードが抜けておりましたので無視して、こちらにご回答ください。 ほんと抜けた話です。すみません。 以下のマクロtest01はエラーになります。 Sub test01() Dim wb As Workbook Set wb = Sheets(1).Copy 'エラー「オブジェクトが必要です」 End Sub もちろん Dim wb As Workbook Sheets(1).Copy Set wb = ActiveWorkbook と修正すればエラーにならないことは存じていますが、ふと疑問がわきました。 Sheets(1).Copyの段階であたらしいWorkbookが誕生していますよね。 ならば、そのWorkbookはオブジェクトではないのでしょうか? Workbooks.Add で誕生したWorkbookは Set wb = Workbooks.Add と変数wbにSetできるのに Set wb = Sheets(1).Copy ができないのが不思議です。 Set wb = ActiveWorkbook としないでもSheets(1).CopyをwbにSetする書き方はないのでしょうか?

  • VBAの繰りかえし処理について

    workbook1(以下wb1)のB3に入力した県名を含む行を、 workbook2から取り出し、wb1のB7以降に表示させたいと思っています (ちなみに県名はwb2のC列に入っています) 同じ県名が含まれる行が多いので、それらを繰り返し処理で 全て書き出したいと思い、以下のマクロを作りました。 Sub macro3() Dim c Dim wb1 As Workbook Dim wb2 As Workbook Dim k As Integer Dim firstAddress As String Application.ScreenUpdating = False Set wb1 = ActiveWorkbook Set wb2 = Workbooks.Open("G:\zyouhousyori\inn100best_full.csv") Set c = cell.Find(What:=Range("B3").Value) With wb2.Worksheets(1).Range("A1:A100") If Not c Is Nothing Then firstAddress = c.Address Do Set c = cell.FindNext(c) For k = 0 To 10 .Range("C100").End(xlUp).Offset(1).Copy _ wb1.Worksheets("sheet1").Cells(7 + k, 2) Exit For ★Loop While Not c Is Nothing And _ c.Address <> firstAddress End If End With Application.ScreenUpdating = True wb2.Close False End Sub しかし、実行すると★マークのついた所でエラーになってしまいます (対応するDoがありません、と出ます) VBA初心者なので、どこがどう違うのかいまいちわかりません; アドバイスお願いします。

  • ExcelVBA 標準モジュール内関数の呼出し

    VB6.0からExcelの標準モジュール内のパラメータ付関数を呼出すにはどうしたらよろしいでしょうか? Dim app As Excel.Application Dim wb As Workbook Set app = CreateObject("excel.application") Set wb = app.Workbooks.Open("TestXl.xls") Set app = Nothing 以上のように記述し指定のエクセルファイルをオープンすることはできたのですが ここからどうやって標準モジュールを参照し、その中の関数を実行するかがわかりません。

  • VBAでの質問

    お世話になります。 下記の記述で、「←」の矢印の記述で、 Cells.(5,2)がブランクでなければ、 「→」から進めたいのですが、 どの様に記述すれば宜しいでしょうか ご教示お願いします。 Sub 表記入() Dim Data As Range Dim i As Integer Dim j As Integer Dim k As Integer Set Data = Sheets("集計").Range("A2").CurrentRegion j = 16 k = 0 With Sheets("表") For i = 3 To Data.Rows.Count If Data.Cells(i, 51) <> "" Then .Cells(5, 2) = Data.Cells(i, 3)  ← .Cells(5, 7) = Data.Cells(i, 4) → .Cells(j, 2) = Data.Cells(i, 10) .Cells(j, 6) = Data.Cells(i, 11) & Data.Cells(i, 12) .Cells(j, 14) = Data.Cells(i, 51) Else End If k = k + 1 If k = 10 Then j = j + 18 k = 0 Else j = j + 1 End If End If Next i End With End Sub