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

解決済みの質問

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() で始まるので丸められることが可能ならも含めていい方法を御指導いただけると幸甚です。
宜しくお願いします。

投稿日時 - 2014-07-31 20:14:28

QNo.8699675

すぐに回答ほしいです

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

追加です。

(1)についてですが、そのままでも動作はするとおもいますが・・・
(1ヶ所間違いがありましたので直しています:3行目)
既に使用されている名前であったり、シート名に設定出来ない文字の場合はエラーになるかとおもいます。
以下のようにすることでエラーを回避できます。
(無効な名前が入力された場合はダイアログが表示され、名前は変わりません)

(1)のコード

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

投稿日時 - 2014-07-31 20:57:11

お礼

早速にご丁寧な御指導誠に有難うございました。
色々試したもののなかなかうまく行かず困っていました。
ご質問して良かったです。

投稿日時 - 2014-07-31 21:31:14

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

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

回答(2)

ANo.1

(1)はそのままに

(2)と(3)を合わせています。

Private Sub Workbook_Open()
Dim mySheet As Worksheet
For Each mySheet In Worksheets
  mySheet.Tab.ColorIndex = xlNone
  If mySheet.Name = Format(Now(), "yyyymmdd") Or mySheet.Name = Month(Now) Then
    mySheet.Tab.ColorIndex = 3
  End If
Next
End Sub

投稿日時 - 2014-07-31 20:43:02

あなたにオススメの質問