• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:VBAでのシートの色が)

VBAでのシートの色を指定したい方法

tsubuyukiの回答

  • ベストアンサー
  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.2

Private Sub Workbook_Open() Dim sh As Worksheet     For Each sh In Worksheets         If isnumeric(sh.Name) Then             sh.Tab.ColorIndex = xlNone             If sh.Name = Month(Now) Then                 sh.Tab.Color = 255 ' 赤             End If         End If     Next End Sub

dorasuke
質問者

お礼

試させていただきました。 8 ~ 9 に該当月が替わっても 8のシートタブの赤が消え 9のシートタブの赤が付き、 尚且つ1~12のシート以外のタブの色はそのままで私の思いのままです。 ありがとうございました。

関連するQ&A

  • VBAで該当月が変わるとのシートの色が

    いつもお世話になります。 Win7 Excell20010 です。 該当月にシートタブに色を付けるために下記のマクロを記述しています。 シートタブには半角で 「1 ~ 12」 の名前を付けています。 先月の 「8」 のシートタブは赤で色付けができていました。 該当する今月(9)になると「8 9」の両方のシートタブに赤が色付けされています。 この場合 「8」 は無色で、該当する今月のシートタブ 「9」 のみだけに色付けするには 下記のマクロをどのように変更すればいいかご指導いただけませんでしょうか。 参考に ThisWorkbook Workbook Open に記述 Private Sub Workbook_Open() Dim sh As Worksheet For Each sh In Worksheets If sh.Name = Month(Now) Then sh.Tab.Color = 255 ' 赤 End If Next End Sub

  • VBAで二つの構文を繋げるには

    いつもお世話になります。 WIN7 EXCELL2010 です。 1) A1に 数値化した日付を入力するとシート名表示に反映される。  例えば 2014/07/31 で A1 には 20140731 と入力するとシート名にも      20140731 が表示 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub 2) 1)で表示された複数のシートから今日のシート名になっているシートの色付けです。 Private Sub Workbook_Open() Dim mySheet As Worksheet For Each mySheet In Worksheets mySheet.Tab.ColorIndex = 19 If mySheet.Name = Format(Now(), "yyyymmdd") Then mySheet.Tab.ColorIndex = 3 End If Next End Sub 3) 各月をまとめたシートで シート名は 1~12 あります。 このシート名にも色付けするため下記マクロを追加したいのですが、1)のマクロとどう繋げばいいか分かりません。 Private Sub Workbook_Open() Dim sh As Worksheet     For Each sh In Worksheets         If isnumeric(sh.Name) Then             sh.Tab.ColorIndex = xlNone             If sh.Name = Month(Now) Then                 sh.Tab.Color = 255 ' 赤             End If         End If     Next End Sub 同じ Private Sub Workbook_Open() で始まるので丸められることが可能ならも含めていい方法を御指導いただけると幸甚です。 宜しくお願いします。

  • 複数の条件でVBAによるシートの並びえ変え

    いつもお世話になります。 WIN7 EXCELL2010 です。 シート数が多くなると並び替えが大変で何とかして省力化を図りたいです。 インターネットのVBAでシートでシートの並び替えをいろいろ調べましたがただ単純に 昇順 降順 でした。 もう少し工夫したVBAが可能ならばと下記のように考え御指導を仰ぎたいです。 御指導を仰ぎたいのは、 参照図で説明しますと 下側 が今月の並びです。 上側が 来月です。 だから マクロで 下側 から 上側 のようにシートの並び替えがマクロで可能でしょうか。 もしも可能ならご教授いただけませんでしょうか。 条件 1 シート名「記入」 は一番左側に 条件 2 シート名「祭日」 は一番右側に 条件 3 例えば今月の場合、 08 が 「記入」右側 その右から 0801 0802 0803 0804 という具合に 9月になると 例えばコマンドボタンで 09 が 「記入」右側 その右から 0901 0902 0903 0904 です ※ 1月~12月分があって途中で重くなることもあって過ぎたシートは適時削除します。 参考に 下記マクロはすでに適用しています。 1) シート名のマクロ (A1に文字列の数字 例えば今日ですと 20140802 08 で文字列です) Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Call StName_change(Sh, Target.Value) End If End Sub Private Sub StName_change(Sh As Object, word As String) On Error GoTo era Sh.Name = word Exit Sub era: MsgBox word & "は無効な名前です" End Sub 2) 該当日 該当月の色付けマクロ Private Sub Workbook_Open() Dim mySheet As Worksheet For Each mySheet In Worksheets mySheet.Tab.ColorIndex = xlNone If mySheet.Name = Format(Now(), "mmdd") Or mySheet.Name = Format(Now(), "mm") Then mySheet.Tab.ColorIndex = 3 End If Next End Sub 何かむつかしい質問をしていますが是非是非ご協力いただけませんでしょうか。

  • エクセルVBAでパスの¥マークについて

    このマクロを記述したBOOKと同じフォルダー内にある、シート001.xls を開くマクロです。 同一フォルダーにあるのですから、このような記述になると思います。 Sub kakunin1() Workbooks.Open (ThisWorkbook.Path & "\" & "シート001.xls") End Sub しかし、以下の3つはすべてシート001.xls を開くことができました。 Sub kakunin2() Workbooks.Open (ThisWorkbook.Path & "\" & "\" & "シート001.xls") End Sub Sub kakunin3() Workbooks.Open (ThisWorkbook.Path & "\" & "\" & "\" & "シート001.xls") End Sub Sub kakunin4() Workbooks.Open (ThisWorkbook.Path & "\" & "\" & "\" & "\" & "\" & "\" & "シート001.xls") End Sub パスの¥マークは階層をあらわすのだと思っていましたがいくつ重ねてもなぜ開くのでしょうか?非常に初歩的な質問だと思いますが、ご教示いただければ幸いです。

  • 今日の日付に該当するシート名に赤色を

    いつもお世話になります。 WIN7 EXCELL2010 です。 A1に「20140721」と記入しエンターキーを押すと下記のマクロでシート名が自動で「20140721」となるようにしています。 例えば今日(7月21日)になったら自動で赤色にしていくつかあるシートの中で今日のシートを目指させたいのでご指導いただけませんでしょうか。 参考に Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub 是非ご協力をお願いします。

  • <マクロ・VBA> 大きいEnterキーを押してVBA処理

    はじめまして。よろしくお願いします。 ワークシートに入力して、 入力内容により色をつけるというVBAを作っています。 Enterキー(大きい方)を押したら 即時情報が更新されるものを作りたいんですが、 大きいEnterキーで更新する方法が分かりません。 どうぞご教授宜しくお願いします。 やりたいこと>> (1)大きいEnterキーを押してすぐ内容を判定して行に色をつける (2)行の色は以下の通り  削除…赤  変更…薄い黄色  その他…色はなし 記述>> 【ThisWorkBook】 Private Sub Workbook_Open() キー定義 End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) キー定義の解除 End Sub -------------------------------------------------- 【標準モジュール】 Sub キー定義() Application.OnKey "{ENTER}", "判定" End Sub Sub 判定() If ActiveWorkbook.Name = "色付けテスト" Then If ActiveCell.Value = "削除" Then ActiveCell.EntireRow.Interior.ColorIndex = 3 ElseIf ActiveCell.Value = "変更" Then ActiveCell.EntireRow.Interior.ColorIndex = 36 Else: ActiveCell.EntireRow.Interior.ColorIndex = xlNone End If End If End Sub 今のところはテンキーのEnterキーで対応しています。 よろしくお願いします。

  • オープンオフィスでシート名をセルから参照するには

    マクロ初心者です。 こちらの質問(http://okwave.jp/qa/q2025849.html)と同じような内容ですが、 試行錯誤してもOpenOffice Calcでできなかったため質問させていただきます。 OpenOffice Calcで、セル「A1」に入力されてある文字を対応するシートの名前に自動で設定するには、どのようなマクロを記述すればいいのでしょうか? エクセルで使用できる Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub をVBA互換モードで試しましたが、無理そうでしたのでOpenOffice.org Basicで使えるように変換して記述したいところです。 ですが、オープンオフィスのThisWorkbookはどのように使うのかなどさっぱり理解できなかったので、どなたか詳しい方教えてください。 よろしくお願いします。

  • 強制的にマクロを有効にするVBA

    エクセル2010を使っている者です。 マクロの入ったファイルを開くときに、強制的にマクロを有効にするようなVBAは どのように組めば良いか、ご教授願います。 ネットで調べてみると、以下のものが見つかりました。 http://www.saka-en.com/office/vba-open-the-macro-enabled-forcibly/ 1 Option Explicit 2 3'** 4 ' ワークブックオープン 5'** 6 Private Sub Workbook_Open() 7 ThisWorkbook.Unprotect Password:="password" 8 On Error Resume Next 9 If ThisWorkbook.Sheets("編集用").Visible <> True Then ThisWorkbook.Sheets("編集用").Visible = True 10 If ThisWorkbook.Sheets("ダミー").Visible <> False Then ThisWorkbook.Sheets("ダミー").Visible = False 11 ThisWorkbook.Protect Password:="password" 12 'ThisWorkbook.RunAutoMacros Which:=xlAutoOpen 13 On Error GoTo 0 14 Exit Sub 15 End Sub 16 17 '** 18' ワークブックを閉じる前 19 '** 20 Private Sub Workbook_BeforeClose(Cancel As Boolean) 21 Dim Answer As Long 22' 保存されているかチェック 23 If ThisWorkbook.Saved = False Then 24 Answer = MsgBox("Do you want to save the changes to the '" & ThisWorkbook.Name & "' ?", vbExclamation + vbOKCancel, "Microsoft Excel") 25 Select Case Answer 26 Case vbCancel 27 Cancel = True 28 Exit Sub 29 End Select 30 End If 31 ThisWorkbook.Unprotect Password:="password" 32 On Error Resume Next 33 If ThisWorkbook.Sheets("ダミー").Visible <> True Then ThisWorkbook.Sheets("ダミー").Visible = True 34 If ThisWorkbook.Sheets("編集用").Visible <> False Then ThisWorkbook.Sheets("編集用").Visible = False 35 ThisWorkbook.Protect Password:="password" 36 ThisWorkbook.Save 37 End Sub しかし、このコードだと、編集するシートが1枚であれば良いのですが、何枚もある場合や、随時、シートを追加していくようなファイルの場合は修正が必要だと思います。 どのように修正すれば良いのでしょうか。 もしくは、例えば、マクロが有効になっていない場合は、ファイルは開けるものの、注意喚起のメッセージボックスを有効にするまで表示させるような設定にすることは可能でしょうか。 ご教授いただけると幸いです。 よろしくお願いいたします。

  • エクセルVBAにて保存するとき

    Private Sub Workbook_BeforeClose(Cancel As Boolean) If MsgBox("エクセルを終了してもよろしいですか?", vbYesNo) = vbNo Then Cancel = True Exit Sub End If Application.DisplayAlerts = False Application.Quit End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) MsgBox "そのボタンでは保存できません。" & vbCrLf & _ "雛形は残しておきましょう" & vbCrLf & _ "" & vbCrLf & _ "ツールバーの「マクロなし出力」から保存できます。" Cancel = True End Sub という二つのマクロをThisworkbookにいれてあるんですが、 この二つを有効(今は2つ目を'でコメント状態にしてあるので保存可)にすると保存できなくて困っています。 二つを有効にした時はどのようにほぞんすればいいですか?

  • VBA 一個前のシートのデータをコピーして貼付

    (1) Private Sub Workbook_Open()に、マクロの記録で作成した(2)を組み込んで処理をしたいのですが、一つ前のファイルを選択する記述・一つ前のシートを指定する記述が判りません。 ●御教示いただきたい事項 ・(1)で開かれた時、ファイルはマスター.xls が開いていますが、 ファイル名 ccc.xlsが開いた状態にする記述のしかた。     ・(2)が各シートで実行される、共通の記述のしかた。 (1) Private Sub Workbook_Open() Workbooks.Open Filename:="C:\Documents and Settings\aaa\My Documents\bbbマスター\マスター.xls" End Sub (2)  ファイル名 ccc.xlsにマクロの記録で作成 Sub Macro4()     Range("J11").Select     'Sheets("7月")のセル J11 Sheets("6月").Select  Range("I7").Select Selection.Copy Sheets("7月").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub