| |
こんな感じでどうかな ?
[シートモジュール]
Private Sub Worksheet_Activate()
Dim Wp As Single, Hp As Single
Const FPic As String = _
"C:\Documents and Settings\UserName\My Documents\My Pictures\001.jpg"
With ActiveWindow.VisibleRange
Wp = .Width - 10: Hp = .Height - 10
End With
Application.ScreenUpdating = False
With Me.Pictures
If .Count > 0 Then .Delete
With .Insert(FPic)
.Left = 0: .Top = 0
.Width = Wp: .Height = Hp
.OnAction = "Pic_Change"
End With
End With
Application.ScreenUpdating = True
End Sub
[標準モジュール]
Sub Pic_Change()
Dim x As Variant, Ary As Variant
Dim Wp As Single, Hp As Single
Static i As Integer
Const Ph As String = _
"C:\Documents and Settings\UserName\My Documents\My Pictures\"
x = Application.Caller
If VarType(x) <> 8 Then Exit Sub
If InStr(1, x, "図") = 0 Then Exit Sub
Ary = Array("001", "002", "005")
If i = UBound(Ary) Then
i = 0
Else
i = i + 1
End If
With ActiveWindow.VisibleRange
Wp = .Width - 10: Hp = .Height - 10
End With
Application.ScreenUpdating = False
With ActiveSheet
.Pictures(x).Delete
With .Pictures.Insert(Ph & Ary(i) & ".jpg")
.Left = 0: .Top = 0
.Width = Wp: .Height = Hp
.OnAction = "Pic_Change"
End With
End With
Application.ScreenUpdating = True: Erase Ary
End Sub
*使い方
まずシートモジュールのイベントマクロで、定数 Ph に「シートを開いたときに表示
する画像のフルパス」を指定します。標準モジュールの Pic_Change の定数 Ph は、
画像ファイルをまとめて保存しているフォルダのパスにします。
(末尾に \ をつけること) そして配列 Ary の要素には、ファイル名だけを羅列します。
拡張子が異なるものを混在させるなら、Ary = Array("XX.jpg", "YY.gif") などと
して、With .Pictures.Insert(Ph & Ary(i)) と拡張子なしの指定に変更します。
この配列 Ary の順番で、表示されている画像が切り替えられます。配列の下限は 0
ですから、最初の要素となるファイル名を、シートイベントマクロで指定したファイルに
しておけば、最後の要素の画像をクリックしたとき、元に戻るというわけです。
テストしてみると、概ねうまくいっているようですが、
Application.ScreenUpdating の設定では、切り替わりの瞬間に画面がぶれるのを
抑止することが出来ないみたいでした。問題点はそれぐらいです。お試し下さい。
|
|
Kein
- 04/9/3(金) 0:14 -
