VBA

A1(1行)に画像が貼り付いています。
※別のフォルダから持ってきていますが、画像の大きさはバラバラですがA1には縮小されて収まっています。
B1からB7に説明が書いてあります。

この画像をA1からA7まで拡大して、少し余白を持たせて中心に持っていきたいです。

ご教授よろしくお願いします。

質問者からの補足コメント

• 列をB列にし、タイトルを付けるため行を2行挿入してもA1に貼りつきます。Fo To Next も上手くいきません。

  No.1の回答に寄せられた補足コメントです。 補足日時：2024/03/24 16:37

• 複数の行にまたがり拡大することができました。
  ありがとうございました。

    補足日時：2024/03/24 22:28

No.2 回答者： kigoshi 回答日時： 2024/03/26 14:28

> Fo To Next で、A1:A7の部分を変えてやれば良いと思いますが

そこだけでは足りません。
If sp.TopLeftCell.Address = "$A$1" Then
も$A$9、$A$17・・・・と列アドレスを8ずつ増やしながら回す必要があるでしょう。
ご自身でやってみて、うまくいかなかったらそのコードをここに書いて見せて下されば、それに対するご回答が付くかと思います。

No.1 回答者： fujillin 回答日時： 2024/03/24 15:32

こんにちは

やりたいことしか書いてないので、何を質問したいのか不明です。
まるっとコードが欲しいのかも知れませんが、その割には「A1」というセル位置以外は抽象的なので具体的なことがわかりません。

不明点は勝手に解釈して、こんな感じなのでしょうか？
※ 画像は回転していないと仮定しています。
（多分、お好みには合わないかもなので、後はお好きにいじってください）

Sub Q13768724()
Dim sp, r, d

Set r = Range("A1:A7")
d = Application.Min(r.Height, r.Width) / 10
If d = 0 Then Exit Sub
For Each sp In ActiveSheet.Pictures
If sp.TopLeftCell.Address = "$A$1" Then
sp.Top = d / 2
sp.Left = d / 2
sp.ShapeRange.LockAspectRatio = False
sp.Width = r.Width - d
sp.Height = r.Height - d
End If
Next sp
End Sub

この回答へのお礼

こんにちは
思う通りになりました。ありがとうございます。

実は、このような画像が、一行の空白行を挟んで、A9、A17・・・と続いています。
Fo To Next で、A1:A7の部分を変えてやれば良いと思いますが、よろしければ教えていただけないでしょうか。

お礼日時：2024/03/24 15:58