質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.91%

VBAでループのシート移動をしたい

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 282

mori_reta

score 10

前提・実現したいこと

シートに「前へ」「次へ」ボタンを設置してそれを押すとページ移動できるようにしたいです。
また、シートは
HOME|移動範囲1|移動範囲2|移動範囲3|移動範囲4|科目
このようにあり、移動範囲内をループで移動したいです。

例:移動範囲3で次へ→移動範囲4に移動→移動範囲4で次へ→移動範囲1に移動
例:移動範囲2で前へ→移動範囲1に移動→移動範囲1で前へ→移動範囲4に移動

このような形にしたいと思っています。

また、移動範囲のシートは追加することがあるので後ろの判定を科目シートの1つ前で取りたいと思っております。

該当のソースコード

'ページ移動前へ
Sub PrevPage()

    ActiveSheet.Previous.Activate

End Sub


'ページ移動次へ
Sub NextPage()

    ActiveSheet.Next.Activate

End Sub

試したこと

IF文の利用も考えたのですが、For Next文の方がいいのでしょうか?
また、とりあえず次への方から取り組んでみたのですが、上手く動作しませんでした。

'ページ移動前へ
Sub PrevPage()

    ActiveSheet.Previous.Activate

End Sub


'ページ移動次へ
Sub NextPage()
    Dim i As Long

    For i = 2 To Worksheets("科目") '←科目のひとつ前の判定の取り方がわからないです

    Next
    ActiveSheet.Next.Activate

End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

0

こんなんですかね。
それぞれ関数をボタンに割り当ててください。

Sub Next_Click()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Dim n As Long
    If Worksheets(sh.Index + 1).Name = "科目" Then
        n = Worksheets("HOME").Index
    Else
        n = sh.Index + 1
    End If
    sh.Move after:=Worksheets(n)
End Sub

Sub Prev_Click()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Dim n As Long
    If Worksheets(sh.Index - 1).Name = "HOME" Then
        n = Worksheets("科目").Index
    Else
        n = sh.Index - 1
    End If
    sh.Move before:=Worksheets(n)
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2020/07/03 14:23 編集

    ありがとうございます。
    Moveで書かれてますが、質問者さんがActivateとされてるのでSelectが意図したものかと思いました。
    Sub Next_Click()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Dim n As Long
    If Worksheets(sh.Index + 1).Name = "科目" Then
    n = Worksheets("HOME").Index + 1
    Else
    n = sh.Index + 1
    End If
    Sheets(n).Select
    End Sub

    Sub Prev_Click()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Dim n As Long
    If Worksheets(sh.Index - 1).Name = "HOME" Then
    n = Worksheets("科目").Index - 1
    Else
    n = sh.Index - 1
    End If
    Sheets(n).Select
    End Sub

    キャンセル

  • 2020/07/03 14:29 編集

    質問の意図を読み違えたか。。。
    シートを移動させたいではなく、表示するシートを変更したいってことですか。
    だとすればradames1000さんが修正してくださったものでよさそうですね。

    キャンセル

  • 2020/07/03 15:38

    MoveなのかSelectなのか、どちらが求めているものだったのでしょうか?

    キャンセル

0

参考程度です。
アドインメニューへComboboxをシート名で登録して選択する様にすると楽ですよ。
イメージ説明

Option Explicit
'
Public gobjCmdBar As CommandBar
Public gCmdBarBtn As CommandBarButton
Public gobjCmdCombo As CommandBarComboBox

' ***********************************************
' コマンドバー登録
' ***********************************************
Function Test_Sample_Miniature() As Boolean

    Dim MySheet As Worksheet
    Dim Bar As CommandBar
    Dim blnFlag As Boolean

    '試験用でメニュー削除
    Call Close_CommandBar

    'メニュー登録済み確認
    For Each Bar In Application.CommandBars
        If Bar.Name = "メニュー" Then
            Exit Function
        End If
    Next Bar

    'メニュー追加
    Set gobjCmdBar = Application.CommandBars.Add(Name:="メニュー", Temporary:=True)
    gobjCmdBar.Position = msoBarTop
    gobjCmdBar.Visible = True

    'コンボBox追加
    Set gobjCmdBar = gobjCmdBar
    Set gobjCmdCombo = gobjCmdBar.Controls.Add(Type:=msoControlComboBox)

    'コンボBoxリスト追加
    For Each MySheet In ThisWorkbook.Worksheets
        blnFlag = True
        If InStr(MySheet.Name, "Home") > 0 Then blnFlag = False
        If InStr(MySheet.Name, "科目") > 0 Then blnFlag = False
        If blnFlag = True Then
          gobjCmdCombo.AddItem Text:=MySheet.Name
          gobjCmdCombo.OnAction = "SelectSheetActive処理"
        End If
    Next
    gobjCmdCombo.Style = msoComboLabel
    gobjCmdCombo.Text = gobjCmdCombo.List(1)

    '開放
    Set gCmdBarBtn = Nothing
    Set gobjCmdBar = Nothing

End Function

' ***********************************************
' SelectSheetActive処理
' ***********************************************
Function SelectSheetActive処理() As Boolean
    ThisWorkbook.Worksheets(gobjCmdCombo.Text).Activate
End Function

' ***********************************************
' コマンドバーを削除する
' ***********************************************
Function Close_CommandBar() As Boolean
    On Error Resume Next
    gobjCmdCombo.Delete
    Application.CommandBars("メニュー").Delete
End Function

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.91%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る