ExcelのVBAで画面をスクロールさせる(ズーム版)
二枚目のワークシートがスクロールする。
Public Declare Function SetTimer Lib "USER32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Public Declare Function KillTimer Lib "USER32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long Sub TimerStartStop() Set c = ThisWorkbook.Worksheets(1).Cells(1, 2) If c.Value = "" Then c.Value = SetTimer(0&, 31000&, 1000&, AddressOf scroll) Else KillTimer 0&, c.Value c.Value = "" End If End Sub Sub scroll() On Error Resume Next n = ActiveSheet.Name 'Application.ScreenUpdating = False ThisWorkbook.Worksheets(2).Activate ActiveWindow.Zoom = False c = ThisWorkbook.Worksheets(1).Cells(1, 1).Value Range(Cells(1, c), Cells(10, c + 10)).Select ThisWorkbook.Worksheets(1).Cells(1, 1).Value = c + 1 ActiveWindow.Zoom = True Cells(11, c).Select ThisWorkbook.Worksheets(n).Activate 'Application.ScreenUpdating = True End Sub Sub init() ThisWorkbook.Worksheets(1).Cells(1, 1).Value = 1 End Sub