| |
▼困っています さん：
これだけの選択肢があるわけですから、ユーザーフォームで条件をセット、
あるいはシート上のオプションボタン等で条件をセットして実行するのが
わかりやすいとは思いますが、以下は遊びです。
対象領域もマクロ内で選択させます。
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
|
|
β
- 16/3/18(金) 21:05 -
困っています
- 16/3/18(金) 19:26 -
困っています
- 16/3/18(金) 16:19 -
やま
- 16/3/17(木) 16:00 -
