老親介護に悩む30~60代の方へ
老親介護ねっと[老人ホーム編]
トップ 老人ホームの選び方 介護関連ニュース 新規オープンホーム情報 老人ホーム取材レポート お問い合わせ リンク集 Q&A

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

解決済みの質問

削除した写真より下の写真を上に詰める

よろしくお願いします。

連続した工事写真があります。
不特定位置の写真を1枚削除したときに
その写真より下にある写真を上に詰める。

下の構文(参考文コペピ)で1枚削除、この後が解りません。
Private Sub CommandButton1_Click()
Dim Pic As picture
Dim r As Range
If UCase$(TypeName(Selection)) <> "RANGE" Then Exit Sub
For Each Pic In ActiveSheet.Pictures
Set r = Range(Pic.TopLeftCell, Pic.BottomRightCell)
If Selection.Address = Union(Selection, r).Address Then
Pic.Delete
End If
Set r = Nothing
Next
End Sub

補足
写真は、C4、C9,C14・・・(枚数は変動)と、5行置きに入っています。
その中で、C9の写真を削除したときにC14以降の写真(枚数は変動)を、C9を先頭にして移動させる。

C4はそのまま

C9削除

C14の写真をC9へ

C19の写真をC14へ

C24の写真をC19へ

枚数分繰り返し

下手な説明ですが、よろしくお願いします。

投稿日時 - 2018-07-13 00:46:46

QNo.9517711

困ってます

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

参考に
  If UCase$(TypeName(Selection)) <> "RANGE" Then Exit Sub
  myRow = Selection(1).Row
  For Each Pic In ActiveSheet.Pictures
    Set r = Range(Pic.TopLeftCell, Pic.BottomRightCell)
    If Selection.Address = Union(Selection, r).Address Then
      Pic.Delete
    ElseIf Pic.TopLeftCell.Row > myRow Then
      Pic.Top = Pic.TopLeftCell.Offset(-5).Top
    End If
    Set r = Nothing
  Next
End Sub

投稿日時 - 2018-07-13 08:39:53

お礼

早速のご回答ありがとうございました。
私の思い通りにできました。

投稿日時 - 2018-07-15 18:36:07

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

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

回答(3)

ANo.3

アップされたコードでは範囲を選択して範囲内の写真を削除していますね
>不特定位置の写真を1枚削除したときに
この場合、写真を選択して削除した方が良いのでは
※コマンドボタンのTakeFocusOnClickプロパティをFALSE に設定してください。
Private Sub CommandButton1_Click()
  Dim Pic As Variant
  Dim myRow As Long
  If TypeName(Selection) <> "Picture" Then Exit Sub
  myRow = Selection.TopLeftCell.Row
  Selection.Delete
  For Each Pic In ActiveSheet.Pictures
    If Pic.TopLeftCell.Row > myRow Then
      Pic.Top = Pic.TopLeftCell.Offset(-5).Top
    End If
  Next
End Sub

投稿日時 - 2018-07-14 11:08:59

お礼

早速のご回答ありがとうございました。
写真を選ぶ方法もあったのですね。
参考にさせていただきます。

投稿日時 - 2018-07-15 18:23:08

ANo.2

おはようございます。
VBAは分かりませんが、Pic.Deleteは実行できましたか?
これに伴い、
9行目から13行目迄も不要ではないですか
これらの行も削除して不都合はありますか
Rows("9:13").Select
Selection.Delete Shift:=xlUp

投稿日時 - 2018-07-13 08:43:43

お礼

早速のご回答ありがとうございました。
削除すると、その列の文言まで消えてしまいますので
不都合です。

投稿日時 - 2018-07-15 18:28:21