特定のシートをAuto_OpenでアクティブにするVBA

特定のシートをアクティブにするVBAについてなのですが、シート名は【】ごとにあります。↓

【1.1】 【1.2】 【1.3】 【2.1】 【2.2】 【2.3】 【3.1】 【3.2】 【3.3】…続く

左の数字が日付で変わっていきます。
右の数字は業務上の24時間を3つに区切ったものです。

1は 7時から 15時
2は 15時から22時
3は 22時から 7時

それでブックを開いた時に、今の日にちと時間から、特定のシートをアクティブにしたいのですが、難しくてわかりません。

例えば10日の8時にブックを開いたら

【10.1】のシートをアクティブにする。

このVBAを解るかた教えていただけないでしょうか。

よろしくお願いします。

No.4 ベストアンサー 回答者： WindFaller 回答日時： 2015/12/14 02:27

>一部の文字で抽出したファイル名で更新日時を表示するVBA

>の回答の中にあるコードの中に、WindFallerさんのご回答くださったコードを入れるとしたら、どうなるでしょうか。

『特定のシートをAuto_OpenでアクティブにするVBA』
ふたつのマクロをあわせることは可能でも、このご質問のタイトルは、Auto_Open と書かれていました。

簡単なご質問になっていますが、それは、この質問の最初の時点から、確認しなければならないです。まさか、インスタンスを設けるという高度なワザをリクエストされているとは思えません。

単に、ブックを開いて、その開くシートをどこに決めるというのは、Auto_Open ではありません。Auto_Openは、通常、マクロを置いたブックです。ファイルを開くマクロの後に続くのですから、別の名前にしなくてはなりません。名前を変えてください。

なお、更新日時を取得する自体は、外部のオブジェクトを使わないで、プロパテイから取れます。


http://oshiete.goo.ne.jp/qa/9107027.html

Sub openTargetFile()
・
・
・
　　　　If lngSave = vbYes Then
　　　　　Set myBook =Workbooks.Open( findPath & getName)
　　　　　Call mySheetOpen 'Auto_Open を別の名前にした。　ここを変える＊
　　　　Else
　　　　　　MsgBox "終了します。", vbExclamation, "更新時刻"
　　　　　　Exit Sub
　　　　End If
　　　　getName = Dir()
　　Loop
End Sub



Sub mySheetOpen()
・
・
・
　　Set sh = ActiveWorkbook.Worksheets(sName) 'ThisWorkbook をActiveWorkbookに書き換え。＊＊

End Sub

この回答へのお礼

本当に丁寧なご回答ありがとうございます。私の質問の仕方が悪かったです。オートオープンと言ったのは、コードで他のブックを開いたら先で、シートを選択させたいという意図がありました。また、分からなかったら質問を出直します。

お礼日時：2015/12/14 05:07

No.3 回答者： WindFaller 回答日時： 2015/12/13 23:10

#2の補足：

　　'1日のチェック＊
　　If Day(myTime - TimeSerial(7, 0, 0)) - Day(myTime) > 25 Then
　　　　If MsgBox("前月" & Month(Date - 1) & "に該当するようですが、よろしいですか？", vbQuestion + vbOKCancel) = vbCancel Then
　　　　　　Exit Sub
　　　　End If
　　End If

[前月○に該当するようですが、そのまま続行しますか？]

のほうが良いでしょうね。

MakingSheets　のマクロは、シートのフォーマットをコピーするようなものにすべきでした。
リクエストにしたがって、修正します。

この回答へのお礼

いろいろ注文、申し訳ありません。
私の過去の質問の中の

一部の文字で抽出したファイル名で更新日時を表示するVBA

の回答の中にあるコードの中に、WindFallerさんのご回答くださったコードを入れるとしたら、どうなるでしょうか。

お礼日時：2015/12/13 23:46

No.2 回答者： WindFaller 回答日時： 2015/12/13 20:48

こんばんは。

しばらく考えてみました。

私も、以前、変則的(日をまたぐ）な区切りを作ったことがありますが、今回の1,2,3(通常、遅出、夜勤） の区切り方も、実際のシートを開けさせるのは、予想よりも遥かに難しいです。このマクロは、「月」がどこにも書かれていないのに、シートだけで、何月か推定させるわけです。

例えば、12月なのか1月なのか、たぶん、どこかにはあるはずですが、月初めの1日の早朝(7時前)などでは、前月の末日に該当し、ブックが違う可能性があります。そのままでは、その月の末日、もしくは30日に飛んでいってしまいますが、月が違う可能性があるのです。

さて、どのように処理してよいのか、かなり考えてみましたが、小一時間、あれこれいじってみました。1日の7時の前の時間を例外として作らなければならないで、臨時で、月初めの1日のチェックを対話型にしました。(これ自体、感心しませんが、やむをえません。)

細心の注意を払ったつもりですが、ミスがありましたら、ご指摘ください。(しばらくは気がつかないかもしれませんが)

以下、Auto_Openと、その月のシートを作るMakingSheetsというマクロも加えてみました。(現在12月ですが、今、1月を作る時は、InputBox に、該当する年・月を入力してください。)

'//
Sub Auto_Open()
　　Dim myTime As Double
　　Dim sName As String
　　Dim buf As Variant
　　Dim sh As Worksheet
　　myTime = Now
　　' bfore 7　'7時前は、前日の3に該当
　　If myTime < Date + TimeSerial(7, 0, 0) Then
　　　　sName = Day(Date - 1) & "." & 3
　　'7-15
　　ElseIf myTime >= Date + TimeSerial(7, 0, 0) And myTime < Date + TimeSerial(15, 0, 0) Then
　　　　sName = Day(Date) & "." & 1
　　'15-22
　　ElseIf myTime >= Date + TimeSerial(15, 0, 0) And myTime < Date + TimeSerial(22, 0, 0) Then
　　　　sName = Day(Date) & "." & 2
　　'22
　　ElseIf myTime >= Date + TimeSerial(22, 0, 0) And myTime < Date + 1 + TimeSerial(0, 0, 0) Then
　　　　sName = Day(Date) & "." & 3
　　End If
　　On Error Resume Next
　　Set sh = ThisWorkbook.Worksheets(sName)
　　'1日のチェック＊
　　If Day(myTime - TimeSerial(7, 0, 0)) - Day(myTime) > 25 Then
　　　　If MsgBox("前月" & Month(Date - 1) & "に該当するようですが、よろしいですか？", vbQuestion + vbOKCancel) = vbCancel Then
　　　　　　Exit Sub
　　　　End If
　　End If
　　If Err.Number > 0 Then
　　　　MsgBox "該当のシートが見つかりません。", vbExclamation
　　Else
　　　　sh.Select
　　End If
　　On Error GoTo 0
End Sub

Sub MakingSheets()
　　'シートを作るマクロ
　　Dim yr As Variant
　　Dim mon As Variant
　　Dim totalshCount As Long
　　Dim i As Long
　　Dim j As Long
　　Dim n As Long
　　yr = Year(Date)
　　yr = Application.InputBox("年数を入力してください", "年は？", yr)
　　If VarType(yr) = vbBoolean Then Exit Sub
　　mon = Month(Date)
　　mon = Application.InputBox("月数を入力してください", "月は？", mon)
　　If VarType(mon) = vbBoolean Then Exit Sub
　　With ThisWorkbook
　　　　totalshCount = Day(DateSerial(yr, mon + 1, 0))
　　　　Application.ScreenUpdating = False
　　　　For i = 1 To totalshCount
　　　　　　For j = 1 To 3
　　　　　　　　n = n + 1
　　　　　　　　If n > .Worksheets.Count Then
　　　　　　　　 .Worksheets.Add after:=.Worksheets(.Worksheets.Count)
　　　　　　　　End If
　　　　　　　　On Error Resume Next
　　　　　　　　　　DoEvents
　　　　　　　　 .Worksheets(n).Name = i & "." & j
　　　　　　　　On Error GoTo 0
　　　　　　Next j
　　　　Next i
　　End With
　　Application.ScreenUpdating = True
　　MsgBox "終了しました。", vbInformation
End Sub

'///

この回答へのお礼

大変丁寧な回答ありがとうございます。0時をまたぐ日付のこと察していただきありがとうございます。
動作は確認できたのでベストアンサーはさせていただきます。ただ、私の方で作っているコードにどう挿入したら動くかが問題で、試行錯誤しています。コードが長すぎてここに記述できなくて。しばらくお待ちください。

お礼日時：2015/12/13 23:28

No.1 回答者： enunokokoro 回答日時： 2015/12/13 17:55

マクロは苦手なので、もっと良いものが出ると思いますが。

Sub test()
' 今日の日付と指定時間でシートを開きます
Dim niti As String
Dim tv As String
Dim DateSheet As String

' 今日の日付けを取得
　niti = Day(Date)
' 時間区分を数字に変換（時間が重ならないように1秒ずらす）
Select Case Time
　Case TimeValue("07:00:01") To TimeValue("15:00:00")
　tv = "1"
　Case TimeValue("15:00:01") To TimeValue("22:00:00")
　tv = "2"
　Case Else
　tv = "3"
End Select

' シート名を指定
　DateSheet = "【" & niti & "." & tv & "】"
' シート名で指定したシートをアクティブにする
　Worksheets(DateSheet).Activate

End Sub

これを試してみて、Auto_Openにしてみては。

この回答へのお礼

回答誠にありがとうございます。
教えていただいたコードを試行錯誤しましたが、成功にいたりませんでした。
私の知識不足です。

お礼日時：2015/12/13 20:54