- ベストアンサー
個人用マクロブックの有無を確認する方法
Wendy02の回答
- Wendy02
- ベストアンサー率57% (3570/6232)
Test1でよいのですが、大文字・小文字は合わせないといけませんね。 Sub test1() Dim wb As Workbook For Each wb In Workbooks '*↓ここ If StrConv(wb.Name, vbUpperCase) Like "PERSONAL.XLS*" Then MsgBox "個人用マクロブックがあります。" Exit Sub End If Next MsgBox "個人用マクロブックはありません。" End Sub もっと簡単なやり方？ 簡単だと言えるかはわかりません。Perosnal.xls は、必ず、Sheet ひとつがありますから、以下のようにすれば出来ると思います。 Sub Test3() Dim ret As Variant If Val(Application.Version) > 11 Then ret = Workbooks("PERSONAL.XLSM").Worksheets(1).Cells(1, 1).Value Else ret = Workbooks("PERSONAL.XLS").Worksheets(1).Cells(1, 1).Value End If MsgBox IIf(IsError(ret), "個人用マクロブックはありません。", "個人用マクロブックはあります。") End Sub
関連するQ&A
- ブック名、シート名を他のモジュールからも参照可能にする方法
マクロを書く場合に次のように宣言しています。 Sub test() '(1)始まり Dim WB1 As Workbook Dim SH1 As Worksheet Set Wb1 = Workbooks("Book1") Set Sh1 = Wb1.Worksheets("Sheet1") '(1)終わり Msgbox Sh1.Cells(1, 1) end Sub 新たにマクロを書く場合には、その都度上記コードの「'(1)始まり～'(1)終わり」を書いていますが、面倒です。 「Public ～」などのように一箇所に宣言しておけば,他のモジュールからもブックやシートを参照できるようにする方法は無いでしょうか？ よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 新しく開いたブックをアクティブにするマクロ
マクロ 新しく作ったブックをアクティブにする マクロ初心者です。 マクロを使って同階層にあるファイルのアクティブのシートを ひとつのブックにコピーして保存するマクロを作りたいと思ってます。 他の質問を参照して下記のコードを途中まで作成しました。 参照した質問では、 マクロの入っているブックにシートをコピーするようでしたが、 そうすると保存した時にマクロも保存されてしまうので 私なりに調べて、新しいブックにシートコピーするようにしましたが、 この記述の後、新しいブックをアクティブにする記述がわからず、 保存できなくなってしまいました。 ここまで終わるとマクロの入っているブックがアクティブになって終わります。 このあと新しく開いたブックをアクティブにして、 ブックのsheet1～3を削除して、名前をつけて保存したいのですが 開いたブックをアクティブにするマクロをご伝授ください。 あたらしくブックをつくるとbook1～・・・と名前が変わってしまうので 変数で名づけたいのですが、やり方が良くわかりませんのでよろしくお願いします。 何卒よろしくお願いします。 Sub consolid_test() Dim shCnt As Integer Dim Wb As Workbook Dim i As Integer Dim sh As Worksheet Dim nSh As Worksheet Dim fName As String Dim ka As String Application.ScreenUpdating = False '画面更新を一時停止 Application.DisplayAlerts = False Set mb = Workbooks.Add '新しいコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fName = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fName = Empty '全て検索 If fName <> mb.Name Then 'ブック名がこのブックの名前でなければ Set Wb = Workbooks.Open(myfdr & "\" & fName) 'そのブックを開きwbとする。 Wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く ActiveSheet.Name = Range("B16") 'シート名の変更 ActiveSheet.Unprotect 'シート全体をコピーして値にする Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Wb.Close (False) '保存の有無を聞かずに保存しないで閉じる N = N + 1 'ブック数をカウント End If fName = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す ・ ・ ・ ・
- ベストアンサー
- Visual Basic
- エクセルのブックを閉じるマクロについて
エクセルのブックＡとブックＢが開いている状態で、 ブックＡのボタンに登録して実行すると、ブックＡのみ閉じる、 というマクロを作りました。（下部にコードを記載します） このマクロは、２つのブックが開いていると正常に稼働するのですが、 ブックが１つしかない場合、実行時エラーが出てしまいます。 （ブックＡのみ開いた状態でこのボタンを押してもエラーなく閉じたい） 実行時エラーが出ないようにするにはどうすれば良いか、 おわかりの方がいらっしゃいましたら教えて下さい。 どうぞよろしくお願い致します。 Sub このブックのみ閉じる() Dim wa As String wa = "ほかに無い" Dim wb As Workbook For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name Then wa = "ほかにあるよ" End If Next If wa = "ほかに無い" Then Application.DisplayAlerts = False Application.Quit '終了予定 End If Range("D2").Select Selection.ClearContents ThisWorkbook.Close SaveChanges:=False End Sub
- ベストアンサー
- Excel（エクセル）
- 複数シートをブックにするマクロを応用して。。
1ブック内にyymmdd（日付）シートが多数あり、それを月別yymmごとブックを作成するマクロです。 これは以前、回答して頂いた「n-jun」さんの構文です（n-junさん、重宝しています、感謝！） Private Sub CommandButton1_Click() Dim myDic As Object Dim wb1 As Workbook Dim wb As Workbook Dim ws As Worksheet Dim sh As Worksheet Dim myKey Set myDic = CreateObject("Scripting.Dictionary") Set wb1 = ThisWorkbook Application.ScreenUpdating = False For Each sh In wb1.Worksheets myDic(Left(sh.Name, 4) & "_") = Empty Next For Each myKey In myDic.keys For Each sh In wb1.Worksheets If InStr(sh.Name, Left(myKey, 4)) > 0 Then If wb Is Nothing Then wb1.Worksheets(sh.Name).Copy Set wb = ActiveWorkbook Else wb1.Worksheets(sh.Name).Copy after:=wb.Sheets(wb.Sheets.Count) End If End If Next Application.DisplayAlerts = False wb.SaveAs Filename:="C:\仕事\月別" & "\" & Left(myKey, 4) & ".xls" wb.Close Set wb = Nothing Application.DisplayAlerts = True Next Application.ScreenUpdating = True Set myDic = Nothing Worksheets("main").Activate MsgBox "出力完了" End Sub 実は、これをフォルダ内のブックの場合は？ として応用ができないか悩んでいます。 つまり、フォルダ内にyymmddブックが多数あり、 これを月別yymmとして、それぞれまとめたいのです。 Set wb1 = ThisWorkbookの箇所が、 フォルダ内のブック指定になると思うのですが、 下記コードでどうなんでしょうか？動きません。 myfdr = "C:\仕事\月別" fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 Set wb1 = Workbooks.Open(myfdr & "\" & fname) 変更箇所、アドバイス頂ければ助かります。お願いします
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでBOOKを開く際の処理
エクセルVBAでBOOKを開く際の処理 エクセル2000です。 VBAで特定のフォルダー内のBOOKを開き、１枚目のシートSheets(1)のデータを読み込んで別BOOK（マクロを記載したBOOK）にコピペしたら保存せず閉じるコードを下記のように書きました。（かなり簡略化しましたが） これで作動するのですが、万一、そのフォルダー内のBOOKが開いていても１枚目のシートのデータを読み込み後、閉じられてしまいます。 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
- ベストアンサー
- その他MS Office製品
- 他ブックを実行するマクロ
あるexcelファイル（ブック名「自動操作.xlsm」）からべつのexcelファイル（ブック名「a.xlsm」）というファイルを実行するマクロを組んでいます。 Application.Runを用いて「自動操作.xlsm」のコードを以下のように記述しました。 ※「\」は半角の円マークだと考えてくれればいいです。ここで半角の円マークをかいても\と表示されます。また、自動操作とaは同じディレクトリにあります。 Sub Test1() Application.Run "'C:Users\ディレクトリ名\a.xlsm'!test" End Sub また、「a.xlsm」は以下のように記述しました。 Sub test() Dim i As Integer For i = 1 To 5 '移動元ファイルパスの設定 Cells(i, 1) = i Next End Sub ただ１～５行にその行数を記入するマクロです。 a.xlsmを開いた状態でこれを実行すると、「アプリケーション定義またはオブジェクト定義のエラーです」とでます。 a.xlsmを閉じた状態で実行すると、「このブックでマクロが使用できないか、またはすべてのマクロが無効になっている可能性があります」とでます。 いったいなにを間違えているのでしょうか。
- 締切済み
- Visual Basic
- エクセル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
- ベストアンサー
- Excel（エクセル）
- エクセルＶＢＡで非アクティブブックのRow取得
先ほどの質問の文章がおかしかったので再度質問させていただきます。 非アクティブブックの最終行のRowを取得するマクロが ｘｌｓ形式のファイルだと動いていたのですが、xlsm形式に変更後、エラーになってしまいました。 これは仕様の変更によるものなのでしょうか？ Activeteせずに対処する方法があれば教えて頂きたいです。 マクロを実行しているのは"2.xlsm"で、 このファイルがアクティブの状態で "1.xls"が非アクティブです。 "2.xls"のファイルだとエラーにならないのに "2.xlsm"のファイルだとエラーになってしまいます。 Sub ボタン1_Click() Dim 最終行 As Long 最終行 = Workbooks("1.xls").Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row MsgBox 最終行 End Sub
- ベストアンサー
- Visual Basic
- 続 EXCELのマクロでBook1立ち上げ時に自動で別のBookを起動するには
QNo.3774822 「EXCELのマクロでBook1立ち上げ時に自動で別のBookを起動するには」（http://oshiete1.goo.ne.jp/qa3774822.html）でお世話になった者です。その節は多くの方にご回答いただき有難うございました。 前質問ではANo.6にて必要な回答が得られたため締め切り手続きを行ったのですが、この間にANo.7の回答をいただきました。この内容は私にとって大変興味深いもので早速試してみたのですが、私には高度な内容でうまく動作させられませんでした。既に締めていたため新たな質問もできず、こちらに質問させていただく次第です。 次のコードを正しく実行するための記述の仕方をアドバイスいただければ幸いです。 以下ANo.7のご回答者様の回答の抜粋です。 '============================================= 以下は、ほんのお遊びにしか過ぎませんが、こんなことが可能です。 なお、Book1... のような名称というのは、仮の名称であって、特に、それ自体が存在しているとはいえません。 Book1... のSheet1 のA1 に、hirakegoma と入ったときにだけ、別のファイルが開きますが、以下の「待ち時間」の4秒後を過ぎると、何も起こりません。4秒後に入れたものには何も起こりません。開いたと同時では、場合によってはマクロの検索は利かないはずです。 以下のマクロは、カプセル化もしておりませんし、本格的な内容ではありませんが、このようなことが可能です。また、別のソフトのインスタンス生成自体では、Excelのアプリケーションがどのような反応をするかは分かりません。 個人の場合は、"PERSONAL.XLS" ですが、他人に配布する場合は、アドインになると思います。 また、Excelが起動したときに、ブックの中身やブックの名称を全部調べるという方法も可能だと思います。 ループで、 For Each wb In Workbooks If wb.Name Like "Book#*" Then Workbooks.Open "Abc.xls" End If Next '------------------------------------- 'Class1 '------------------------------------- Public WithEvents App As Application Private Sub App_NewWorkbook(ByVal Wb As Workbook) '待ち時間 Const TIMELAG As Integer = 4 Set NewWb = Wb Application.OnTime Now + TimeValue("00:00:" & CStr(TIMELAG)), "OpenSesame" End Sub '-------------------------------------- '標準モジュール '-------------------------------------- Public myClass As New Class1 Public NewWb As Workbook Public Sub OpenSesame() '添付用のブック Const MYBOOK As String = "Test1.xls" With NewWb.Worksheets(1) If StrComp(.Range("A1").Value, "HirakeGoma", 1) = 0 Then If Dir(MYBOOK) <> "" Then Workbooks.Open "Test1.xls" Else MsgBox MYBOOK & "のワークブックが見当たりません。", 48 End If End If End With Set NewWb = Nothing End Sub '-------------------------------------- 'ThisWorkbookモジュール '-------------------------------------- Private Sub Workbook_Open() Set myClass.App = Application End Sub '標準モジュールのAuto_Openの場合は、オートメーションでは、そこを通らない可能性があるから、ThisWorkbook モジュールに入れたほうがよいです。Auto_Open は、あくまで、Excelを単独に開いたときだけです。
- ベストアンサー
- オフィス系ソフト
- エクセルと同じファイル名でｃｓｖを作成するマクロ
エクセルからＣＳＶファイルをYYMMDD付でマクロを使って 作ろうとしていますが拡張子の「.xls」がどうしても残ってしまいます。 例えば、「test.xls」が「test.xls070326.csv」のように。 これを「test070326.csv」とするにはどうしたらよいでしょう。 今のコードはつぎのようにしています。 Sub test1() Dim flname As Variant Dim wb As Workbook flname = ActiveWorkbook.Name + CStr(Format(Date, "yymmdd")) ActiveSheet.Copy ActiveSheet.SaveAs Filename:=flname, _ FileFormat:=xlCSV ActiveWindow.Close savechanges:=False ActiveWorkbook.Close End Sub これでもＣＳＶとしては使えるのですが、気持ちがすっきりしません。 どなたか正解をお願いします。
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございます。 とても勉強になります。