Excel VBA質問箱 IV

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

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


10632 / 13646 ツリー ←次へ | 前へ→

【20704】20122のシート切り替えマクロについて もこ 04/12/15(水) 23:21 質問[未読]
【20715】Re:20122のシート切り替えマクロについて Jaka 04/12/16(木) 10:01 回答[未読]
【20717】Re:20122のシート切り替えマクロについて IROC 04/12/16(木) 10:04 回答[未読]
【20718】Re:20122のシート切り替えマクロについて Jaka 04/12/16(木) 11:20 発言[未読]
【20726】Re:20122のシート切り替えマクロについて もこ 04/12/16(木) 17:48 お礼[未読]

【20704】20122のシート切り替えマクロについて
質問  もこ  - 04/12/15(水) 23:21 -

引用なし
パスワード
   Kein様にお尋ねです
初めて投稿させていただきます。因みにVBA超初心者です。
先日、シート切替の簡単な方法を探していて、たどり着きました。
そして、自分のPCではエクセルを立ち上げるといつも表示されとても便利に使わせていただいております。でも、会社の共有のRidocーSrvにこのファイルを置いたところ、私のPCからは検索が可能なのですが、他の人のPCからだとニコチャンマークやコンボボックスは出てきますが、機能しません。そのファイルを開けたときには誰からでもニコチャン機能が使えるようにするにはどうすればいいのでしょうか?教えていただけませんでしょうか?お願いいたします。

【20715】Re:20122のシート切り替えマクロについて
回答  Jaka  - 04/12/16(木) 10:01 -

引用なし
パスワード
   こんにちは。

仕様が違いますが、私が使っているやつから抜粋してみました。
右クリックメニューにボタンを作成。
シート数60枚までですが..。


標準モジュール

'右クリックメニュー追加
Sub Auto_Open()
  右クリメニュー追加
  End
End Sub
  
Sub 右クリメニュー追加()
  'On Error Resume Next
  Set 右クリメニュー = Application.CommandBars("cell").Controls.Add _
     (Type:=msoControlButton, temporary:=True)
  With 右クリメニュー
    .Caption = "選択(複数)"
    .FaceId = 264
    .OnAction = "シート複数選択"
  End With
  With Application.CommandBars("Cell")
    '.Reset
  End With
End Sub

Sub シート複数選択()
  UserForm1.Show
End Sub


フォームモジュール
(注)フォーム上のボタンとかその他の類は一切いりません。
   マクロで都度作ってます。

Public WithEvents CmBottan21 As MSForms.CommandButton
Public WithEvents CmBottan22 As MSForms.CommandButton

Dim i As Long, j As Long, n As Long, WShC As Long, CheckCnt As Long
Dim ボタン位置高 As Single, 実行ボタン位置横 As Long, 繰返し As Long
Const 行間隔 = 16, ボタン基準値 = 50 '52.25
Const チェック標準数 = 5

Private Sub CmBottan21_Click()
  Unload Me
  End
End Sub

Private Sub CmBottan22_Click()
  Dim ShTBL() As String
  CheckCnt = 0
  Application.DisplayAlerts = False
  For i = 1 To 繰返し
    If Me.Controls("MCheckBox" & i) = True Then
      CheckCnt = CheckCnt + 1
    End If
  Next
  CheckCnt = 0
  For i = 1 To 繰返し
    If Me.Controls("MCheckBox" & i) = True Then
      CheckCnt = CheckCnt + 1
      ReDim Preserve ShTBL(1 To CheckCnt)
      ShTBL(CheckCnt) = Me.Controls("MCheckBox" & i).Caption
    End If
  Next
  Unload Me
  Application.DisplayAlerts = True
  On Error Resume Next
  ert = ShTBL(1)
  If Err = 0 Then
    Sheets(ShTBL).Select
  End If
  Err.Clear
  On Error GoTo 0
  Erase ShTBL
  End
End Sub

Private Sub UserForm_Initialize()
  n = 0: WShC = Worksheets.Count
  Me.Width = 240
  Me.Caption = "シート選択"
  Select Case WShC
    Case Is <= 10
       j = 5
       Me.Height = 140.25  '標準状態
       ボタン位置高 = Me.Height - ボタン基準値
       実行ボタン位置横 = 135
       繰返し = WShC
    Case Is <= 16
       j = Application.RoundUp(16 / 2, 0)
       Me.Height = 140.25 + 行間隔 * (j - チェック標準数)
       ボタン位置高 = Me.Height - ボタン基準値
       実行ボタン位置横 = 135
       繰返し = WShC
    Case Is <= 20
       j = Application.RoundUp(20 / 2, 0)
       Me.Height = 140.25 + 行間隔 * (j - チェック標準数)
       ボタン位置高 = Me.Height - ボタン基準値
       実行ボタン位置横 = 135
       繰返し = WShC
    Case Is <= 30
       j = Application.RoundUp(30 / 3, 0)
       Me.Height = 140.25 + 行間隔 * (j - チェック標準数)
       ボタン位置高 = Me.Height - ボタン基準値
       実行ボタン位置横 = 340 - 105 '340 - 150
       繰返し = WShC
       Me.Width = 340
    Case Is <= 35
       j = Application.RoundUp(35 / 3, 0)
       Me.Height = 140.25 + 行間隔 * (j - チェック標準数)
       ボタン位置高 = Me.Height - ボタン基準値
       実行ボタン位置横 = 340 - 105
       繰返し = WShC
       Me.Width = 340
    Case Is <= 45
       j = Application.RoundUp(45 / 3, 0)
       Me.Height = 140.25 + 行間隔 * (j - チェック標準数)
       ボタン位置高 = Me.Height - ボタン基準値
       実行ボタン位置横 = 340 - 105
       繰返し = WShC
       Me.Width = 340
    Case Is <= 60
       j = Application.RoundUp(60 / 4, 0)
       Me.Height = 140.25 + 行間隔 * (j - チェック標準数)
       Me.Width = 440
       ボタン位置高 = Me.Height - ボタン基準値
       実行ボタン位置横 = Me.Width - 105
       繰返し = WShC
    Case Else
       MsgBox "シート枚数が多すぎます。" & vbCrLf & _
          "現在のシート枚数には、対応しておりません。" & vbCrLf & _
          "最高60枚、それ以上は表示されません。"
       j = Application.RoundUp(45 / 3, 0)
       Me.Height = 140.25 + 行間隔 * (j - チェック標準数)
       Me.Width = 440
       ボタン位置高 = Me.Height - ボタン基準値
       実行ボタン位置横 = Me.Width - 105
       繰返し = 60
       'Exit Sub
  End Select
  For i = 1 To 繰返し
    If n = j Then
      n = 0
    End If
    n = n + 1
    Set CheckBox追加 = Me.Controls.Add("Forms.CheckBox.1", "MCheckBox" & i)
    With Me.Controls("MCheckBox" & i)
      If i <= j Then
       .Left = 15
      ElseIf i <= j * 2 Then
       .Left = 120
      ElseIf i <= j * 3 Then
       .Left = 225
      Else
       .Left = 325
      End If
      If n = 1 Then
       .Top = 0
      Else
       .Top = n * 行間隔 - 行間隔
      End If
      .Height = 行間隔
      .Caption = Worksheets(i).Name
    End With
  Next
  Set CmBottan21 = Me.Controls.Add("Forms.CommandButton.1", "終了ボタン")
  With Me.Controls("終了ボタン")
    .Caption = "終 了"
    .Width = 75
    .Top = ボタン位置高
    .Left = 25
    .SetFocus
  End With
  Set CmBottan22 = Me.Controls.Add("Forms.CommandButton.1", "選択ボタン")
  With Me.Controls("選択ボタン")
    .Caption = "シートの選択"
    .Width = 75
    .Top = ボタン位置高
    .Left = 実行ボタン位置横  '135
  End With
End Sub

【20717】Re:20122のシート切り替えマクロについて
回答  IROC  - 04/12/16(木) 10:04 -

引用なし
パスワード
   シート選択のメニューを表示するなら、このような方法もありますよ。

Sub sample()
  Application.CommandBars("WorkBook Tabs").ShowPopup
End Sub

【20718】Re:20122のシート切り替えマクロについて
発言  Jaka  - 04/12/16(木) 11:20 -

引用なし
パスワード
   http://www.vbalab.net/vbaqa/data/excel/log/tree_381.htm
>>CommandBars("Workbook tabs").ShowPopupこれって、シートタブの横の▲上で右クリックすると出てくる奴ですね。

って、右クリックすればすむ事なんで、あえて書きませんでした。

【20726】Re:20122のシート切り替えマクロについて
お礼  もこ  - 04/12/16(木) 17:48 -

引用なし
パスワード
   Jakaさん&IROCさん

どうもありがとうございます。
一度試しましたが、まだ理解できておおりませんで、うまくいきませんでした。
もう少し本を見て、勉強して試してみます。でも、色々な方法があるのが勉強になりました。ありがとうございます。
また分からないようでしたらUPしますので宜しくお願い致します。
とり急ぎ、お礼まで。。。

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