HOME > エクセルVBA > サンプル > Sheet

Sheet


【ファイル名】Sheet.xlsm
【バージョン】Ver 1.0.4
【作成日】2015年02月16日
【更新日】2016年12月18日
【動作確認】Windows 7
【必要なソフト】Microsoft Excel 2010
【ダウンロード】Sheet.zip
【説明】Sheetのサンプルです。
メニュー

注意 Replace, InStr, InStrRev関数のvbTextCompareで比較しても、半角の「\」と全角の「¥」を区別します。
エクセルのAsc関数は全角1文字の「ヴ」を半角の「ヴ」に変換しません。

シートの名前の文字数は1文字から31文字です。
シートの名前に下記の18個の文字は使用できません。
'*/:?[\]’V*/:?[¥]\
シート名のエラーメッセージ
またシングルクォーテーション(',’,V)の3文字と、バックスラッシュ(\)も使用できません。
シャープ記号(#)はエラーではないが、ハイパーリンクとして使用できません。

「履歴」のみのシート名は予約されているので変更できません。(「閲覧履歴」、「履歴書」など履歴を含むことは可能)
シート名のエラーメッセージ
「閲覧」タブの「変更履歴の記録」の「変更箇所の表示」メニューの「新しいシートに変更箇所一覧を作成する」により、「履歴」の名前のシートが作成されます。
他のアプリケーションで作成されて既に「履歴」のシート名がある場合は「履歴 (2)」などに変更されます。

シート名の数字と丸囲み数字を区別しません。1と①、2と②、3と③など......

【マイクロソフトのサイト】(コロン、円記号、疑問符、角カッコ、スラッシュ、アスタリスクしか記載されてません)

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="Sample" insertBeforeMso="TabHome" keytip="SAM">
        <group id="Group1" label="Sheet">
          <box id="Box1" boxStyle="horizontal">
 <!-- ■■■ プロパティ -->
            <menu id="PropertyMenu" label="プロパティ(&amp;P)" itemSize="normal" imageMso="PropertySheet" size="normal" keytip="P">
              <button id="ActiveWorkbookSheetsCountButton" label="ActiveWorkbook.Sheets.Count(&amp;S)" supertip="シートの数を表示します。"  imageMso="NumberStyleGallery" onAction="onAction" />
              <button id="ActiveWorkbookWorksheetsCountButton" label="ActiveWorkbook.Worksheets.Count(&amp;W)" supertip="ワークシートの数を表示します。"  imageMso="ColumnActionsChangeType" onAction="onAction" />
              <button id="VisibleSheetCountButton" label="表示しているシートの数(&amp;V)" supertip="表示しているシートの数を表示します。"  imageMso="V" onAction="onAction" />
              <button id="SelectedSheetsCountButton" label="ActiveWindow.SelectedSheets.Count(&amp;E)" supertip="選択しているシートの数を表示します。"  imageMso="S" onAction="onAction" />
              <menuSeparator id="PropertyMenuSeparator1" />
              <button id="HyperlinksCountButton" label="Hyperlinks.Count(&amp;H)" supertip="ハイパーリンクの数を表示します。"  imageMso="HyperlinkInsert" onAction="onAction" />
              <button id="CommentsCountButton" label="Comments.Count(&amp;C)" supertip="コメントの数を表示します。"  imageMso="NewComment" onAction="onAction" />
              <button id="HPageBreaksCountButton" label="HPageBreaks.Count(&amp;P)" supertip="水平方向の改ページの数を表示します。"  imageMso="PageNumber" onAction="onAction" />
              <button id="ActiveSheetNameButton" label="ActiveSheet.Name(&amp;N)" supertip="アクティブシートの名前を表示します。"  imageMso="NameDefine" onAction="onAction" />
              <button id="IsSheetButton" label="シートが存在するか(&amp;E)" supertip="入力した名前のシートが存在するかを表示します。"  imageMso="SelectSheet" onAction="onAction" />
              <button id="TabColorIndexButton" label="Tab.ColorIndex(&amp;I)" supertip="シートの見出しの色の番号を表示します。"  imageMso="ColorMenu" onAction="onAction" />
            </menu>
 <!-- ■■■ メソッド -->
            <menu id="MethodMenu" label="メソッド(&amp;M)" itemSize="normal" imageMso="Spade" size="normal" keytip="M">
              <button id="InsertButton" label="Insert(&amp;I)" supertip="アクティブシートの前に新しいワークシートを挿入します。"  imageMso="SheetInsert" onAction="onAction" />
              <button id="AddButton" label="Add(&amp;A)" supertip="シートの最後に新しいワークシートを挿入します。"  imageMso="SheetInsert" onAction="onAction" />
              <menuSeparator id="MethodMenuSeparator1" />
              <button id="CopyButton" label="Copy(&amp;C)" supertip="アクティブシートを新しいワークシートにコピーします。"  imageMso="Copy" onAction="onAction" />
              <button id="MoveButton" label="Move(&amp;M)" supertip="アクティブシートを左端に移動します。"  imageMso="MoveTaskMenu" onAction="onAction" />
              <menuSeparator id="MethodMenuSeparator2" />
              <button id="SheetVeryHiddenSheetButton" label="xlSheetVeryHidden(&amp;H)" supertip="アクティブシートを非表示にします。&#13;(シートタブを右クリックして、再表示メニューを実行しても表示できません!)"  imageMso="WindowHide" onAction="onAction" />
              <button id="AllDisplaySheetButton" label="すべてのシートを再表示(&amp;S)" supertip="すべてのシートを再表示します。"  imageMso="WindowUnhide" onAction="onAction" />
              <menuSeparator id="MethodMenuSeparator3" />
              <button id="AllSelectWorkSheetsButton" label="すべてのワークシートを選択(&amp;W)" supertip="すべてのワークシートを選択します。&#13;(グラフシート、マクロシート、ダイアログシートは含まれません)"  imageMso="WindowsCascade" onAction="onAction" />
              <button id="ListButton" label="シートの一覧のメニュー(&amp;L)" supertip="シートの一覧のメニューを表示して選択します。"  imageMso="ListToolPreviewOff" onAction="onAction" />
              <menuSeparator id="MethodMenuSeparator4" />
              <button id="DeleteButton" label="Delete(&amp;D)" supertip="選択したシートをすべて削除します。"  imageMso="Delete" onAction="onAction" />
            </menu>
          </box>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

このページの上

SheetModule
Option Explicit
' 【注意】SheetsとWorksheetsを勘違いしやすいので注意すること!
' Sheets・・・シート(ワークシート、グラフシート、ダイアログシート、マクロシート)
' Worksheets・・・ワークシート
Private Const vbUseCompareOption = -1
Private rbRibbonUI As IRibbonUI   ' リボン
Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理l
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  Dim s As String

  On Error GoTo ErrorHandler ' エラー処理ルーチン
  Select Case control.ID
'---< プロパティ >--------------------------------------------------------------------------------------------------------
    Case "ActiveWorkbookSheetsCountButton"
      MsgBox Prompt:=ActiveWorkbook.Sheets.Count, Buttons:=vbInformation, Title:="ActiveWorkbook.Sheets.Count"
    Case "ActiveWorkbookWorksheetsCountButton"
      MsgBox Prompt:=ActiveWorkbook.Worksheets.Count, Buttons:=vbInformation, Title:="ActiveWorkbook.Worksheets.Count"
    Case "SelectedSheetsCountButton"
      MsgBox Prompt:=ActiveWindow.SelectedSheets.Count, Buttons:=vbInformation, Title:="SelectedSheets.Count"
    Case "VisibleSheetCountButton"
      MsgBox Prompt:=VisibleSheetCount(ActiveWorkbook), Buttons:=vbInformation, Title:="表示しているシートの数"
    Case "CommentsCountButton"
      If TypeName(ActiveSheet) = "Worksheet" Then MsgBox Prompt:="Comments.Count = " & ActiveSheet.Comments.Count, Buttons:=vbInformation, Title:="Comments.Count"
    Case "HyperlinksCountButton"
      If TypeName(ActiveSheet) = "Worksheet" Then MsgBox Prompt:="Hyperlinks.Count = " & ActiveSheet.Hyperlinks.Count, Buttons:=vbInformation, Title:="Hyperlinks.Count"
    Case "HPageBreaksCountButton"
      If TypeName(ActiveSheet) = "Worksheet" Then MsgBox Prompt:="HPageBreaks.Count = " & ActiveSheet.HPageBreaks.Count, Buttons:=vbInformation, Title:="HPageBreaks.Count"
    Case "ActiveSheetNameButton"
      MsgBox Prompt:=Application.ActiveSheet.Name, Buttons:=vbInformation, Title:="ActiveSheet.Name"
    Case "IsSheetButton"
      s = Application.InputBox(Prompt:="シート名:", Title:="シート名の入力", Default:="", Type:=2)
      If s = "False" Then Exit Sub
      If IsSheet(s, ActiveWorkbook) Then
        MsgBox Prompt:="入力した名前のシートはあります。", Buttons:=vbInformation, Title:="シートが存在するか"
      Else
        MsgBox Prompt:="入力した名前のシートはありません!", Buttons:=vbInformation, Title:="シートが存在するか"
      End If
    Case "TabColorIndexButton"
      MsgBox Prompt:="Tab.ColorIndex = " & Application.ActiveSheet.Tab.ColorIndex, Buttons:=vbInformation, Title:="Tab.ColorIndex"
'---< メソッド >--------------------------------------------------------------------------------------------------------
    Case "InsertButton"
      ActiveWorkbook.Worksheets.Add Before:=Application.ActiveSheet, Count:=1, Type:=xlWorksheet
    Case "AddButton"
      ActiveWorkbook.Worksheets.Add after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), Count:=1, Type:=xlWorksheet
    Case "CopyButton"
      Application.ActiveSheet.Copy ' コピー先を指定しないので、新しいブックが作成されます。
    Case "MoveButton"
      Application.ActiveSheet.Move Before:=ActiveWorkbook.Sheets(1)
    Case "SheetVeryHiddenSheetButton" ' xlSheetVeryHiddenはシートタブメニューの「再表示」メニューでは表示できません!
      Application.ActiveSheet.Visible = xlSheetVeryHidden ' 表示はxlSheetVisible、ふつうの非表示はxlSheetHidden
    Case "AllDisplaySheetButton"
      AllDisplaySheet ActiveWorkbook
    Case "AllSelectWorkSheetsButton"
      AllSelectWorkSheets ActiveWorkbook
    Case "ListButton"
      Application.CommandBars("Workbook tabs").ShowPopup
    Case "DeleteButton"
      Call DeleteSelectSheet
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical, Title:="エラー"
  End Select
  Exit Sub

ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical, Title:="エラー"
End Sub
'===========================================================
'すべてのワークシートを選択
'===========================================================
Sub AllSelectWorkSheets(wb As Workbook)
  Dim i As Long
  Dim IsReplace As Boolean

  IsReplace = True
  For i = 1 To wb.Worksheets.Count
    If wb.Worksheets(i).Visible = xlSheetVisible Then ' ●非表示のシートを選択するとエラーになる!
      wb.Worksheets(i).Select IsReplace
      IsReplace = False
    End If
  Next i
End Sub
'===========================================================
' 指定したブックの表示されているシート数を取得します。
'===========================================================
Function VisibleSheetCount(wb As Workbook) As Long
  Dim i As Long, cnt As Long

  cnt = 0
  For i = 1 To wb.Sheets.Count
    If wb.Sheets(i).Visible = xlSheetVisible Then cnt = cnt + 1
  Next i
  VisibleSheetCount = cnt
End Function
'===========================================================
' 指定したブックの表示されているワークシート数を取得します。(グラフシート、マクロシート、ダイアログシートは含まれません)
'===========================================================
Function VisibleWorksheetCount(wb As Workbook) As Long
  Dim i As Long, cnt As Long

  cnt = 0
  For i = 1 To wb.Worksheets.Count
    If wb.Worksheets(i).Visible = xlSheetVisible Then cnt = cnt + 1
  Next i
  VisibleWorksheetCount = cnt
End Function
'===========================================================
' 指定したシートの名前が存在するか取得します。
'===========================================================
Function IsSheet(SheetName As String, Optional objWorkbook As Variant) As Boolean
' SheetName・・・シート名
' objWorkbook・・・ワークブック(省略した場合はアクティブ ワークブック)
  Dim sh As Variant

  IsSheet = False
  If IsMissing(objWorkbook) Then
    If ActiveWorkbook Is Nothing Then
      Exit Function
    Else
      Set objWorkbook = ActiveWorkbook
    End If
  End If

  On Error Resume Next ' エラーを無視して次の行を実行します。
  Err.Clear
  Set sh = objWorkbook.Sheets(SheetName)
  If Err.Number = 0 Then IsSheet = True
  Set sh = Nothing
  On Error GoTo 0
End Function
'===========================================================
' 指定したワークシートの名前が存在するか取得します。
'===========================================================
Function IsWorksheet(SheetName As String, Optional objWorkbook As Variant) As Boolean
' SheetName・・・ワークシート名
' objWorkbook・・・ワークブック(省略した場合はアクティブ ワークブック)
  Dim sh As Variant

  IsWorksheet = False
  If IsMissing(objWorkbook) Then
    If ActiveWorkbook Is Nothing Then
      Exit Function
    Else
      Set objWorkbook = ActiveWorkbook
    End If
  End If

  On Error Resume Next ' エラーを無視して次の行を実行します。
  Err.Clear
  Set sh = objWorkbook.Worksheets(SheetName)
  If Err.Number = 0 Then IsWorksheet = True
  Set sh = Nothing
  On Error GoTo 0
End Function
'===========================================================
' すべてのシートを表示する
'===========================================================
Sub AllDisplaySheet(wb As Workbook)
  Dim i As Long

  For i = 1 To wb.Sheets.Count
    wb.Sheets(i).Visible = xlSheetVisible
  Next i
End Sub
'===========================================================
' 選択したすべてのシートを削除します。
'===========================================================
' 【注意】シートが保護されている場合は削除できません。
Sub DeleteSelectSheet()
  Dim i As Long
  Dim an() As String

  If ActiveWorkbook Is Nothing Then Exit Sub
  ' シートを削除した後に表示されるシートが1以上必要です!
  If (VisibleSheetCount(ActiveWorkbook) + 1) < ActiveWindow.SelectedSheets.Count Then Exit Sub
  If MsgBox(Prompt:="選択したすべてのシートを削除しますか?", Buttons:=vbQuestion + vbYesNo, Title:="確認") <> vbYes Then Exit Sub
  On Error Resume Next ' エラーを無視して次の行を実行します。
  Application.DisplayAlerts = False ' 確認メッセージを表示しないで、シートを削除します。
  ' 選択したシート名を保存します。
  ReDim an(1 To ActiveWindow.SelectedSheets.Count)
  For i = LBound(an) To UBound(an)
    an(i) = ActiveWindow.SelectedSheets(i).Name
  Next i
  ' 選択したシートをすべて削除します。
  For i = LBound(an) To UBound(an)
    ActiveWorkbook.Sheets(an(i)).Delete
  Next i
  Application.DisplayAlerts = True
  On Error GoTo 0
End Sub
'===========================================================
' 検索の文字列中の文字が1つでもあれば、その位置を取得します。
'===========================================================
Function InChar(Expression As String, FindChars As String, Optional Compare As VbCompareMethod = vbUseCompareOption) As Long
  Dim IsFind As Boolean
  Dim eLen As Long, fLen As Long, i As Long, j As Long
  Dim ec As String, fc As String

  InChar = 0 ' 見つからない
  eLen = Len(Expression)
  If eLen < 1 Then Exit Function
  fLen = Len(FindChars)
  If fLen < 1 Then Exit Function

  For i = 1 To eLen
    ec = Mid$(Expression, i, 1)
    For j = 1 To fLen
      fc = Mid$(FindChars, j, 1)
      If Compare = vbUseCompareOption Then
        IsFind = StrComp(ec, fc) = 0
      Else
        IsFind = StrComp(ec, fc, Compare) = 0 ' StrCompのvbTextCompareで、半角の\と全角の¥を同じと判断できます。
      End If
      If IsFind Then
        InChar = i
        Exit Function
      End If
    Next j
  Next i
End Function
'===========================================================
' アクティブワークブックに指定したシートがあるか?
'===========================================================
Function ExistsSheet(SheetName As String) As Boolean
  Dim sh As Object ' Sheetオブジェクトはありません。

  ExistsSheet = False
  If ActiveWorkbook Is Nothing Then Exit Function
  On Error Resume Next
  Set sh = ActiveWorkbook.Sheets(SheetName)
  ExistsSheet = Not (sh Is Nothing)
  On Error GoTo 0
End Function
'===========================================================
' シートの名前に使用できない文字をイミディエイト ウィンドウに出力します。
'===========================================================
Sub CnaNotSheetNameChar()
' シートの名前に18個の文字が使用できません。
' '*/:?[\]’V*/:?[\]¥

' Char  Dec  Hex
' '      39   27
' *      42   2A
' /      47   2F
' :      58   3A
' ?      63   3F
' [      91   5B
' \      92   5C
' ]      93   5D
' '    8217 2019
' V  65287 FF07
' *  65290 FF0A
' /  65295 FF0F
' :  65306 FF1A
' ?  65311 FF1F
' [  65339 FF3B
' \  65340 FF3C
' ]  65341 FF3D
' ¥  65509 FFE5

  Dim SheetName As String, s As String, c As String, o As String
  Dim i As Long, l As Long, cnt As Long

  If MsgBox(Prompt:="時間がかかりますが、実行しますか?", Buttons:=vbYesNo + vbQuestion, Title:="確認") <> vbYes Then Exit Sub
  On Error Resume Next
'  SendKeys "^g" ' イミディエイト ウィンドウを表示します。
  Application.ScreenUpdating = False
  SheetName = ThisWorkbook.Sheets(1).Name
  o = ""
  cnt = 0
  For i = 9 To 65535
    Err.Clear
    c = ChrW(i)
    ThisWorkbook.Sheets(1).Name = c
    If Err.Number <> 0 Then
      Debug.Print c & vbTab & i & vbTab & WorksheetFunction.Dec2Hex(i)
      o = o & c
      cnt = cnt + 1
    End If
    If (i Mod 5000) = 0 Then ' 5000の値は環境により異なります。
      DoEvents ' 応答不能にならないように制御を渡します。
    End If
  Next i
  Debug.Print o
  Debug.Print cnt
  ThisWorkbook.Sheets(1).Name = SheetName
  Application.ScreenUpdating = True
  On Error GoTo 0
End Sub
'===========================================================
' シートの名前に使用できる文字列か検査します。
' 【注意】既にシートの名前が使われているかは検査しません。
'===========================================================
Function CheckUseSheetNameChar(SheetName As String) As Boolean
  Dim c

  CheckUseSheetNameChar = False
  If Len(SheetName) < 1 Then Exit Function  ' シートの文字数は1文字以上でかつ
  If Len(SheetName) > 31 Then Exit Function ' 31文字以下です。
  If InChar(SheetName, "'*/:?[\]’V*/:?[\]¥", vbBinaryCompare) > 0 Then Exit Function ' 18文字は使用できません。
  CheckUseSheetNameChar = True ' OK
End Function
'===========================================================
' シート名で使えない文字を削除します。'*/:?[\]’V*/:?[\]¥
'===========================================================
Function RemoveSheetNameBadChar(SheetName As String) As String
  Dim sn As String

  sn = Replace(SheetName, ":", "", Compare:=vbTextCompare) ' ◆ 半角と全角を区別しないで比較する
  sn = Replace(sn, "\", "", Compare:=vbTextCompare)  ' ◆ 全角の¥は削除できない(Replace, InStr, InStrRevはバグ)
  sn = Replace(sn, "¥", "", Compare:=vbTextCompare) ' ◆ 必要
  sn = Replace(sn, "/", "", Compare:=vbTextCompare)
  sn = Replace(sn, "\", "", Compare:=vbTextCompare)
  sn = Replace(sn, "?", "", Compare:=vbTextCompare)
  sn = Replace(sn, "*", "", Compare:=vbTextCompare)
  sn = Replace(sn, "'", "", Compare:=vbTextCompare)
  sn = Replace(sn, "’", "", Compare:=vbTextCompare)
  sn = Replace(sn, "[", "", Compare:=vbTextCompare)
  RemoveSheetNameBadChar = Replace(sn, "]", "", Compare:=vbTextCompare)
End Function
'===========================================================
' 存在しないシート名の取得
'===========================================================
Function GetNewSheetName(Optional SheetName As String = "Sheet") As String
  Dim IsEnd As Boolean
  Dim i As Long
  Dim sName As String

  sName = RemoveSheetNameBadChar(SheetName) ' シート名で使えない文字を削除します。
  If Len(sName) < 1 Then sName = "Sheet"
  IsEnd = False     '        シート名の文字数は1文字以上でかつ31文字以内です。
  i = 1
  Do Until (IsEnd = True)
    If ExistsSheet(sName) = False Then ' 存在しないシート名の場合は
      GetNewSheetName = sName          ' 【注意】ワークシート以外のシートにも同じ名前があってはいけない!
      Exit Function
    End If
    sName = SheetName & CStr(i)
    i = i + 1
  Loop
End Function
'===========================================================
' アクティブ シートの前に表示されているシートを取得します。
'===========================================================
Function GetVisiblePreviousSheet() As Object
  Dim sh As Object

  If Application.ActiveSheet Is Nothing Then
    Set GetVisiblePreviousSheet = Nothing
    Exit Function
  End If

  Set sh = Application.ActiveSheet
  Do While Not sh Is Nothing
    Set sh = sh.Previous
    If sh Is Nothing Then
      Set GetVisiblePreviousSheet = Nothing
      Exit Function
    End If
    If sh.Visible = XlSheetVisibility.xlSheetVisible Then
      Set GetVisiblePreviousSheet = sh
      Exit Function
    End If
  Loop
End Function
'===========================================================
' アクティブ シートの次に表示されているシートを取得します。
'===========================================================
Function GetVisibleNextSheet() As Object
  Dim sh As Object

  If Application.ActiveSheet Is Nothing Then
    Set GetVisibleNextSheet = Nothing
    Exit Function
  End If

  Set sh = Application.ActiveSheet
  Do While Not sh Is Nothing
    Set sh = sh.Next
    If sh Is Nothing Then
      Set GetVisibleNextSheet = Nothing
      Exit Function
    End If
    If sh.Visible = XlSheetVisibility.xlSheetVisible Then
      Set GetVisibleNextSheet = sh
      Exit Function
    End If
  Loop
End Function
'===========================================================
' アクティブ ワークブックの最初に表示されているシートを取得します。
'===========================================================
Function GetVisibleFirstSheet() As Object
  Dim i As Long
  Dim sh As Object

  If Application.ActiveSheet Is Nothing Then
    Set GetVisibleFirstSheet = Nothing
    Exit Function
  End If

  With Application.ActiveWorkbook.Sheets
    For i = 1 To .Count
      If .Item(i).Visible = XlSheetVisibility.xlSheetVisible Then
        Set GetVisibleFirstSheet = .Item(i)
        Exit Function
      End If
    Next i
  End With
End Function
'===========================================================
' アクティブ ワークブックの最後に表示されているシートを取得します。
'===========================================================
Function GetVisibleLastSheet() As Object
  Dim i As Long
  Dim sh As Object

  If Application.ActiveSheet Is Nothing Then
    Set GetVisibleLastSheet = Nothing
    Exit Function
  End If

  With Application.ActiveWorkbook.Sheets
    For i = .Count To 1 Step -1
      If .Item(i).Visible = XlSheetVisibility.xlSheetVisible Then
        Set GetVisibleLastSheet = .Item(i)
        Exit Function
      End If
    Next i
  End With
End Function
'===========================================================
' 前のシートを選択します。
'===========================================================
Sub PrevSheet()
'SendKeys "^{PGUP}" ' ショートカット キーをエミュレーションして前のシートを選択します。
  On Error Resume Next
  Application.ActiveSheet.Previous.Select
  On Error GoTo 0
End Sub
'===========================================================
' 次のシートを選択します。
'===========================================================
Sub NextSheet()
'SendKeys "^{PGDN}" ' ショートカット キーをエミュレーションして次のシートを選択します。
  On Error Resume Next
  Application.ActiveSheet.Next.Select
  On Error GoTo 0
End Sub
'===========================================================
' 入力した文字列を含むシートを選択します。
'===========================================================
Sub SelectFindSheet()
  Dim IsReplace As Boolean
  Dim Str As Variant
  Dim sh As Object

  If Application.ActiveSheet Is Nothing Then Exit Sub
  Str = Application.InputBox(Prompt:="シート名に含まれる文字列:", Title:="入力した文字列を含むシートを選択", Type:=2)
  If VarType(Str) = vbBoolean Then Exit Sub
  If Len(Str) < 1 Then Exit Sub
  Str = Replace(Str, "ヴ", "ヴ") ' 1文字の「ヴ」を半角の「ヴ」に変換する(Asc関数では半角にできないため)
  Str = WorksheetFunction.Asc(LCase(Str)) ' ◆ 英字の小文字。カタカナの全角の濁音・半濁音は1文字と2文字の場合があるので半角にすること

  IsReplace = True
  For Each sh In ActiveWorkbook.Sheets
    If sh.Visible = xlSheetVisible Then
      If InStr(1, WorksheetFunction.Asc(LCase(Replace(sh.Name, "ヴ", "ヴ"))), Str, vbBinaryCompare) > 0 Then ' ◆ カタカナとひらがなを区別する
        sh.Select Replace:=IsReplace ' 最初のみ今までの選択を解除してから選択します。
        IsReplace = False
      End If
    End If
  Next sh
End Sub
'===========================================================
' アクティブ ブックの選択したシートの名前をイミディエイト ウィンドウに出力します。
'===========================================================
Sub DebugPrintSelectedSheetsName()
Dim i As Long

For i = 1 To ActiveWindow.SelectedSheets.Count
  Debug.Print ActiveWindow.SelectedSheets(i).Name
Next i
End Sub
'===========================================================
' アクティブシートを左端に移動します。
'===========================================================
Sub SheetMoveFirst()
  On Error Resume Next
  Application.ActiveSheet.Move Before:=ActiveWorkbook.Sheets(1)
  On Error GoTo 0
End Sub
'===========================================================
' アクティブシートを右端に移動します。
'===========================================================
Sub SheetMoveLast()
  On Error Resume Next
  Application.ActiveSheet.Move after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
  On Error GoTo 0
End Sub

このページの上