Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4300 / 76734

←次へ　｜　前へ→


	【78058】Re:指定範囲内の行、及び列を、指定数おきに非表示または選択したい

β - 16/3/17(木) 17:34 -


	引用なし

	パスワード

▼困っていますさん：

これだけの選択肢があるわけですから、ユーザーフォームで条件をセット、
あるいはシート上のオプションボタン等で条件をセットして実行するのが
わかりやすいとは思いますが、以下は遊びです。
対象領域もマクロ内で選択させます。

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function SetWinEventHook Lib "user32" _
　　　　(ByVal eventMin As Long, ByVal eventMax As Long, _
　　　　ByVal hmodWinEventProc As Long, _
　　　　ByVal pfnWinEventProc As Long, _
　　　　ByVal idProcess As Long, ByVal idThread As Long, _
　　　　ByVal dwFlags As Long) As Long
Private Declare Function UnhookWinEvent Lib "user32" _
　　　　(ByVal hWinEventHook As Long) As Long
Const WINEVENT_OUTOFCONTEXT = &H0
Const EVENT_SYSTEM_ALERT = &H2
Private Declare Function SetDlgItemText Lib "user32" _
　　　　Alias "SetDlgItemTextA" _
　　　　(ByVal hDlg As Long, ByVal nIDDlgItem As Long, _
　　　　ByVal lpString As String) As Long

Sub Test()
　　Dim ans As Variant
　　Dim ansStr As String
　　Dim disp As VbMsgBoxResult
　　Dim DoRow As VbMsgBoxResult
　　Dim n As Long
　　Dim r As Range
　　Dim msg As String
　　Dim x As Long
　　Dim a As Range
　　Dim func As Boolean
　　
　　On Error Resume Next
　　Set r = Application.InputBox("処理する領域を選択してください", Type:=8)
　　On Error GoTo 0
　　
　　If r Is Nothing Then Exit Sub
　　
　　SetWinEventHook EVENT_SYSTEM_ALERT, EVENT_SYSTEM_ALERT, _
　　　　　　　　　　0, AddressOf WinEventProc1, 0, _
　　　　　　　　　　GetCurrentThreadId(), WINEVENT_OUTOFCONTEXT
　　disp = MsgBox("表示/非表示どちらにしますか？", vbYesNoCancel Or vbQuestion)
　　
　　If disp = vbCancel Then Exit Sub
　　
　　If disp = vbYes Then
　　　　msg = "表示"
　　Else
　　　　msg = "非表示"
　　End If
　　
　　SetWinEventHook EVENT_SYSTEM_ALERT, EVENT_SYSTEM_ALERT, _
　　　　　　　　　　0, AddressOf WinEventProc2, 0, _
　　　　　　　　　　GetCurrentThreadId(), WINEVENT_OUTOFCONTEXT
　　DoRow = MsgBox(msg & " が選ばれました" & vbLf & _
　　　　"行/列どちらにしますか？", vbYesNoCancel Or vbQuestion)
　　
　　If DoRow = vbCancel Then Exit Sub
　　
　　If DoRow = vbYes Then
　　　　msg = msg & "/行 "
　　Else
　　　　msg = msg & "/列 "
　　End If
　　
　　n = Application.InputBox(msg & "が選ばれました" & vbLf & "何行おきに処理しますか？", Type:=1)
　　
　　If n = 0 Then Exit Sub
　　
　　If disp = vbYes Then func = True
　　
　　If DoRow = vbYes Then
　　　　For x = 1 To r.Rows.Count Step n
　　　　　　r.Rows(x).EntireRow.Hidden = Not func
　　　　　　r.Rows(x).Offset(1).Resize(n - 1).EntireRow.Hidden = func
　　　　Next
　　Else
　　　　For x = 1 To r.Columns.Count Step n
　　　　　　r.Columns(x).EntireColumn.Hidden = Not func
　　　　　　r.Columns(x).Offset(, 1).Resize(, n - 1).EntireColumn.Hidden = func
　　　　Next
　　End If
　　
End Sub

Private Sub WinEventProc1( _
　　　　　　ByVal hEvent As Long, ByVal dwEvent As Long, _
　　　　　　ByVal hwndMsg As Long, ByVal idObject As Long, _
　　　　　　ByVal idChild As Long, ByVal idThread As Long, _
　　　　　　ByVal dwmsEventTime As Long)
　　UnhookWinEvent hEvent
　　SetDlgItemText hwndMsg, vbYes, "表示"
　　SetDlgItemText hwndMsg, vbNo, "非表示"
　　SetDlgItemText hwndMsg, vbCancel, "や～めた"
End Sub

Private Sub WinEventProc2( _
　　　　　　ByVal hEvent As Long, ByVal dwEvent As Long, _
　　　　　　ByVal hwndMsg As Long, ByVal idObject As Long, _
　　　　　　ByVal idChild As Long, ByVal idThread As Long, _
　　　　　　ByVal dwmsEventTime As Long)
　　UnhookWinEvent hEvent
　　SetDlgItemText hwndMsg, vbYes, "行"
　　SetDlgItemText hwndMsg, vbNo, "列"
　　SetDlgItemText hwndMsg, vbCancel, "や～めた"
End Sub

14 hits

▼

【78053】指定範囲内の行、及び列を、指定数おきに非表示または選択したい 困っています 16/3/17(木) 14:41