| |
▼ks.net さん：
>初めまして。ks.netと申します。
>
>ある特定のワークシート上の任意のカラム幅が変更された際、
>それを察知して動くプロシージャを作ることは可能でしょうか。
>
>シートAのカラム幅が変更された際、同じ変更をシートBへ自動的に適用するようなプログラムを作りたいと考えています。
SetTimerを使っているのでCPUにはそれほど負担がかかりません。
でも、あんまり実用的ではないですね。お遊び程度で
ThisWorkbookモジュールに
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Timer_End
End Sub
対象のシートモジュールに
Option Explicit
Private Sub Worksheet_Activate()
Timer_Start
End Sub
Private Sub Worksheet_Deactivate()
Timer_End
End Sub
標準モジュールに
Option Explicit
Private Declare Function SetTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private lngTimerId As Long
Private dblColW() As Double
Public Sub TimerProc(ByVal lHwnd As Long, _
ByVal lMsg As Long, _
ByVal lTimerID As Long, _
ByVal lTime As Long)
Dim i As Long
On Error GoTo TimerProc_Err
With Worksheets("Sheet1")
For i = 1 To .Columns.Count
If dblColW(i) <> .Columns(i).ColumnWidth Then
Worksheets("Sheet2").Columns(i).ColumnWidth = .Columns(i).ColumnWidth
dblColW(i) = .Columns(i).ColumnWidth
End If
Next
End With
Exit Sub
TimerProc_Err:
Debug.Print Err.Number, Err.Description
Err.Clear
Timer_End
End Sub
Sub Timer_Start()
Dim i As Long
With Worksheets("Sheet1")
ReDim dblColW(1 To .Columns.Count)
For i = 1 To .Columns.Count
dblColW(i) = .Columns(i).ColumnWidth
Next
End With
lngTimerId = SetTimer(Application.hWnd, 1, 300, AddressOf TimerProc)
End Sub
Sub Timer_End()
Dim lngRtn As Long
If lngTimerId <> 0 Then
lngRtn = KillTimer(Application.hWnd, lngTimerId)
lngTimerId = 0
End If
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
