Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


5737 / 76732 ←次へ | 前へ→

【76602】Re:画像の移動
発言  β  - 15/2/6(金) 19:49 -

引用なし
パスワード
   ▼vbaビギナー さん:

こんばんは

まず、元の位置に戻すには、元の位置がどこだったかを認識しなければいけません。
以下は、ブックを開いたときに、元の位置を把握しておき、Changeイベントで参照します。
なお、A列の横に移動している図をそのままにしてブックを保存すると、次回、ブックを開いたときに
元の位置がわからなくなるので、保存前に強制的に元の位置に戻します。

ThisWorkBookモジュールを使いますので、いっそのこと、ChangeイベントもThisWorkbookモジュールに
移します。(シートモジュールのままでもいいのですが、以下の例は、Changeイベントも移すコードです)

まず、シートモジュールのコードを消去してください。

(ThisWorkbookモジュール)

Private Sub Workbook_Open()
  StoreOriginal
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  ResetOriginal
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Sh.Name <> SHN Then Exit Sub
  If Intersect(Target, Sh.Range("A1:A10")) Is Nothing Then Exit Sub
  If Target.Count <> 1 Then Exit Sub
  
  ResetOriginal
  
  Select Case Target.Value
    Case "みかん"
      Sh.Shapes(1).top = Target.top
      Sh.Shapes(1).left = Target.Width
    Case "りんご"
      Sh.Shapes(2).top = Target.top
      Sh.Shapes(2).left = Target.Width
    Case "さかな"
      Sh.Shapes(3).top = Target.top
      Sh.Shapes(3).left = Target.Width
    Case "牛乳"
      Sh.Shapes(4).top = Target.top
      Sh.Shapes(4).left = Target.Width
    Case "こおり"
      Sh.Shapes(5).top = Target.top
      Sh.Shapes(5).left = Target.Width
  End Select

End Sub

(標準モジュール)

Option Explicit

Type pos
  left As Double
  top As Double
End Type

Public s1 As pos
Public s2 As pos
Public s3 As pos
Public s4 As pos
Public s5 As pos

Public Const SHN As String = "Sheet1"   '該当シート名

Sub StoreOriginal()
  With Sheets(SHN)
    s1.left = .Shapes(1).left
    s1.top = .Shapes(1).top
    s2.left = .Shapes(2).left
    s2.top = .Shapes(2).top
    s3.left = .Shapes(3).left
    s3.top = .Shapes(3).top
    s4.left = .Shapes(4).left
    s4.top = .Shapes(4).top
    s5.left = .Shapes(5).left
    s5.top = .Shapes(5).top
  End With
End Sub

Sub ResetOriginal()
  With Sheets(SHN)
    .Shapes(1).left = s1.left
    .Shapes(1).top = s1.top
    .Shapes(2).left = s2.left
    .Shapes(2).top = s2.top
    .Shapes(3).left = s3.left
    .Shapes(3).top = s3.top
    .Shapes(4).left = s4.left
    .Shapes(4).top = s4.top
    .Shapes(5).left = s5.left
    .Shapes(5).top = s5.top
  End With
End Sub

1 hits

【76601】画像の移動 vbaビギナー 15/2/6(金) 14:23 質問[未読]
【76602】Re:画像の移動 β 15/2/6(金) 19:49 発言[未読]
【76603】Re:画像の移動 β 15/2/6(金) 20:45 発言[未読]
【76606】Re:画像の移動 vbaビギナー 15/2/9(月) 8:33 お礼[未読]
【76604】Re:画像の移動 マナ 15/2/7(土) 13:54 発言[未読]
【76605】Re:画像の移動 マナ 15/2/7(土) 17:34 発言[未読]
【76607】Re:画像の移動 vbaビギナー 15/2/9(月) 8:37 お礼[未読]

5737 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free