Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


44682 / 76735 ←次へ | 前へ→

【37068】Re:リストを利用して、シートの移動
回答  Kein  - 06/4/20(木) 17:37 -

引用なし
パスワード
   提出書類シートのシートモジュールに入れて下さい。A1セルに入力規則を設定する、
という前提で全ての処理が出来るコードにしてみました。

Private Sub Worksheet_Activate()
  Dim MyR As Range
  Dim WS As Worksheet
  Dim SAry() As String
  Dim i As Integer
 
  On Error Resume Next
  Set MyR = Intersect(Range("A1"), _
  Range("A1").SpecialCells(-4174))
  On Error GoTo 0
  If MyR Is Nothing Then
   For Each WS In Worksheets
     If WS.Index <> ActiveSheet.Index Then
      i = i + 1
      ReDim Preserve SAry(i): SAry(i) = WS.Name
     End If
   Next
   Range("A1").Validation.Add xlValidateList, _
    , , Join(SAry, ",")
   Err.Clear: Erase SAry
  Else
   Set MyR = Nothing
  End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim WS As Worksheet
  Dim WsN As String, SAry() As String
  Dim Ans As Integer, i As Integer
 
  With Target
   If .Address <> "$A$1" Then Exit Sub
   If .Count > 1 Then Exit Sub
   If IsEmpty(.Value) Then Exit Sub
   WsN = .Value
  End With
  On Error Resume Next
  Worksheets(WsN).Activate
  If Err.Number <> 0 Then
   Err.Clear
   Ans = MsgBox("選択した名前のシートがありません" & _
   vbLf & "リストを更新しますか", 36)
   If Ans = 6 Then
     For Each WS In Worksheets
      If WS.Index <> ActiveSheet.Index Then
        i = i + 1
        ReDim Preserve SAry(i): SAry(i) = WS.Name
      End If
     Next
     Target.Validation.Modify xlValidateList, _
     , , Join(SAry, ",")
     If Err.Number <> 0 Then
      Target.Validation.Add xlValidateList, _
       , , Join(SAry, ",")
     End If 
     Erase SAry
   End If
  End If
End Sub
0 hits

【37062】リストを利用して、シートの移動 16茶 06/4/20(木) 16:38 質問
【37063】Re:リストを利用して、シートの移動 Statis 06/4/20(木) 16:43 回答
【37066】Re:リストを利用して、シートの移動 16茶 06/4/20(木) 16:50 質問
【37067】Re:リストを利用して、シートの移動 Statis 06/4/20(木) 16:53 発言
【37092】Re:リストを利用して、シートの移動 16茶 06/4/21(金) 8:17 発言
【37068】Re:リストを利用して、シートの移動 Kein 06/4/20(木) 17:37 回答
【37069】Re:リストを利用して、シートの移動 Kein 06/4/20(木) 17:42 発言
【37091】Re:リストを利用して、シートの移動 16茶 06/4/21(金) 8:09 お礼

44682 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free