こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

【Excel VBA】1クリックで1ページ移動する

Excel2003を使用しています。

Sheet1はデータ入力用のシートとなっていて、Sheet1にデータを入力すると、Sheet2の予め作成されている書式にデータが入力されて、書類が完成するようになっています。
実際、プリントアウトするのはSheet2になるのですが、Sheet1にデータを入力して、Sheet2への入力状態を確認したいときに、ボタンをクリックすることで、1ページずつ移動させるようにしたいのですが、マクロで可能でしょうか?可能であれば、どのようにコードを記述すればいいでしょうか?

イメージしているものは、例えば、『上へ』と『下へ』という2つのボタンを作って、そのボタンのクリックで移動できたらと思っています。
Sheet2の1ページは26行で、1ページ目はA1:M26、2ページ目はA27:M52、3ページ目はA53:M78…となっていて、100ページまであって、行数は2000行を超えますし、今後、ページ数が増えることも考えられますので、1クリックで1ページ分移動できると確認しやすく便利だなと思い、質問させていただきました。

よろしくお願いします。

投稿日時 - 2007-08-31 16:48:30

QNo.3303566

暇なときに回答ください

質問者が選んだベストアンサー

こんばんは。

これは、私が、数年使っているコードを作り変えたものです。
A列目の画面の4行目までをクリックすると、バックします。
A列の27行目以降をクリックすると、前に進みます。

動くボタンという方式もありますが、意外にうっとうしいものです。


シートタブを右クリックして、コードの表示で、以下を貼り付けてください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim i As Long
  Dim j As Long
  '1列目を指定
  If Target.Column <> 1 Then Exit Sub
  i = Int((Target.Row - 20) / 26) + 1
  j = ActiveWindow.ScrollRow
  Application.EnableEvents = False
  If (Target.Row - j) < 5 And Target.Row > 26 Then
    Application.Goto Cells((i - 1) * 26 + 1, 1), True
  ElseIf (Target.Row - j) > 25 Then
    Application.Goto Cells(i * 26 + 1, 1), True
  End If
  Application.EnableEvents = True
End Sub

投稿日時 - 2007-08-31 23:07:12

お礼

Wendy02 さん、おはようございます。
いつもお世話になっています。

先程、教えていただいたコードで試してみたところ、うまくいきました!
最初、表示(ズーム)を1ページ分に合わせていなかったせいか、うまくいかなかった(?)ようなのですが、ズームを調整したところ、バッチリでした(^。^)
しかも、ページの1行目が画面の一番上に表示されるので、とっても見やすいです♪

>動くボタンという方式もありますが、意外にうっとうしいものです。

“動くボタン”というものに、興味があるのですが、もし、よろしければ、こちらの方法も教えていただけると、嬉しいのですが。。。
Wendy02 さんが言われている“意外にうっとうしい”というのも、体験できればと思います(笑)

投稿日時 - 2007-09-03 10:03:39

ANo.2

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

#1です。
#2さんの動きはおもしろいですね(^^)勉強になりました。
ところで、私のコードにバグがあったようで申し訳ありまあせん。
その後の回答を見たところ動くボタンで対応されているようなので、デバッグはしないとして。
ただ、一つだけ気になることだけ記載します。
回答者などのコードは自分なりに理解することです。

>よろしければ、こちらの削除の仕方も教えていただけると助かります。

Application.CommandBars("Cell").add()
であれば
Application.CommandBars("Cell").Reset
であるか
Application.CommandBars("Cell").delete(名前)
であるか見当が付くか、または自分でも調べる事をしないと上達はしません。
ここは、分からない事を聞く場所でもあると同時に前提として向上心があるという事も大事だと私は思います。
説教がましく受け止めず、前向きにがんばって下さい。そういう姿勢を応援したいです。

投稿日時 - 2007-09-03 14:33:01

お礼

再度の回答ありがとうございます。

VBA勉強中ですので、いろんな方のいろんな回答を見るだけでも、大変参考になります。
今までも、マクロに関する質問をさせていただいておりますが、今回のような操作を便利にするようなマクロは初めてでしたので、恥ずかしながら、見当もつかなかったということもあり、再度、質問させていただいた次第です。

おかげさまで勉強になりました。ありがとうございました。

投稿日時 - 2007-09-03 15:02:36

ANo.3

こんにちは。

>“動くボタン”というものに、興味があるのですが、もし、よろしければ、こちらの方法も教えていただけると、嬉しいのですが。。。

うっとうしいと書きましたが、興味を抱いていただいてうれしいです。実は、私は、これも、実際は使っています。ボタンが画面についてくるものです。この方法は、別のことにも応用できるはずです。

今回は、コントロールツールのボタンを選びましたが、これも前からなので、実際は、フォームボタンを使っています。どちらでもよいですが、少しコードが変わります。場所は、空いている列の上の場所においてください。後は、自動的に位置決めが決まります。

シートモジュールに以下のマクロをつけてください。前回と同じ調整は必要です。

コマンドボタンのCaptionに、[左-Down, 右-Up] と入れると良いと思います。右クリックは、すこし反応が鈍いのは、マウスのせいかもしれません。もちろん、スピンボタンのほうが分かりやすいのは言うまでもありませんが、場所を取るのがいやなので、今回は、コマンドボタンを選びました。

Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'左クリック-進む-Down
'右クリック-戻る-Up
  Dim WinTop As Long
  Dim i As Long
  i = Int((ActiveCell.Row) / 26) + 1
  If Button = 1 Then
    Application.Goto Cells(i * 26, 1), True
  ElseIf Button = 2 Then
    If i > 1 Then
      Application.Goto Cells((i - 2) * 26 + 1, 1), True
    End If
  End If
    WinTop = ActiveWindow.VisibleRange.Top + 2 '(2は縦の位置調整)
    CommandButton1.Top = WinTop
End Sub

投稿日時 - 2007-09-03 10:58:03

お礼

Wendy02 さん、こんにちは。

早速、“動くボタン”についても回答をいただき嬉しいです。ありがとうございます。

ひとつのボタンを左クリックか右クリックで、進む-Down か 戻る-Up ができるなんて、ちょっと感激してしまいました!
最初、進む-Down と 戻る-Up は別々のボタンだと思っていて、ボタンをふたつ作ってしまい、??の状態でした(^^ゞ

“うっとうしい”なんて、とんでもないです。
今回はNo.2の方法とNo.3の方法とどちらにしようか、迷ってしまうぐらいです。

ありがとうございました。

投稿日時 - 2007-09-03 14:02:54

ANo.1

こんにちは
少し趣向を変えています
下記のコードをThisWorkbookに
Private Sub Workbook_Open()
Dim AM_a, AM_b
Set AM_a = Application.CommandBars("Cell").Controls.Add()
Set AM_b = Application.CommandBars("Cell").Controls.Add()
With AM_a
.Caption = "後ページへ"
.OnAction = "P_Down"
.BeginGroup = False
End With
With AM_b
.Caption = "前ページへ"
.OnAction = "P_Up"
.BeginGroup = False
End With
End Sub
下記のコードをモジュールに貼り付けてください

Sub P_Up()
Dim AR, p
AR = ActiveCell.Row
With ActiveSheet
If AR < 65510 Then
p = Int(AR / 26)
.Cells((p + 1) * 26, 1).Select
End If
End With
End Sub
Sub P_Down()
Dim AR, p
AR = ActiveCell.Row
With ActiveSheet
If ActiveCell.Row > 26 Then
p = Int(AR / 26)
.Cells(-(p + 1) * 26, 0).Select
End If
End With
End Sub

そして保存し再度読み込みシート2で右クリックするとメニュー下に追加されていますので、試してください。

投稿日時 - 2007-08-31 17:46:38

お礼

回答ありがとうございます。

先程、教えていただいた方法で試したところ、“前ページへ”はうまくいくのですが、“後ページへ”ではエラーが出ました。
エラーが出たときは、下記の部分が黄色で表示されていましたが。。。

>.Cells(-(p + 1) * 26, 0).Select

右クリックメニューに追加する方法は、思いつきませんでしたが、この右クリックメニューに追加したものを削除したい場合は、どうすればいいのでしょうか?元のファイルをコピーしたもので、マクロを試したせいか、“前ページへ”と“後ページへ”が右クリックメニューに2つずつ表示されているので、1つずつにしたいのですが、マクロを削除しても、右クリックメニューからは削除されないようなので…。
よろしければ、こちらの削除の仕方も教えていただけると助かります。

投稿日時 - 2007-09-03 09:47:42

あなたにオススメの質問