表題に関し、作成したマクロが思ったように動きません。
動作目標は以下の通りです。
①選択したセルに実行
②セル内に記載されるパスを参照
③参照したパスの画像を等倍貼り付け
④セルに合わせて画像をリサイズ
⑤結合したセルの中央に配置
⑥ ①~⑤を選択したセルだけ実行 以上
環境はExcel Office365 です。
⑤のセル配置において、結合したセルでうまく動作しません。
結合セルの中央ではなく、結合セルの左上の元セルの範囲において
中央に配置されてしまいます。(枠からはみ出してしまいます)
解決方法等わかりましたらお教えいただけると幸いです。
なお、マクロは以下になります。
記
Sub Shapes_AddPicture()
' 変数定義
Dim filePath As String
Dim targetCell As Range
Dim image As Shape
Dim lastImg As Integer
' エラーを無視する(画像ファイル読込み失敗時用)
On Error Resume Next
' 選択したセル範囲を順次処理
For Each targetCell In Selection.Cells
' セルを選択
targetCell.Select
' 値があれば
If targetCell.Value <> "" Then
' 画像ファイル名として取得
filePath = targetCell.Value
' 画像読込み
Set image = targetCell.Worksheet.Shapes.AddPicture( _
Filename:=filePath, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left, Top:=Selection.Top, _
Width:=0, Height:=0)
'最後に貼った画像を選択
lastImg = ActiveSheet.Shapes.Count
ActiveSheet.Shapes(lastImg).Select
' サイズを等倍にする
With image
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
End With
' 縦横比の固定
Selection.LockAspectRatio = True
' 画像が大きい場合、画像サイズをセル幅に合わせる
If Selection.Width / targetCell.MergeArea.Width > Selection.Height / targetCell.MergeArea.Height Then
Selection.Height = Selection.Height * (targetCell.MergeArea.Width / Selection.Width)
Selection.Width = targetCell.MergeArea.Width
Else
Selection.Width = Selection.Width * (targetCell.MergeArea.Height / Selection.Height)
Selection.Height = targetCell.MergeArea.Height
End If
' 表示位置をセル中央に移動
Selection.Top = targetCell.Top + (targetCell.Height - Selection.Height) / 2
Selection.Left = targetCell.Left + (targetCell.Width - Selection.Width) / 2
End If
Next
End Sub
以上
No.1ベストアンサー
- 回答日時:
こんにちは
ちゃんとは見ていませんが・・・
>結合セルの中央ではなく、結合セルの左上の元セルの範囲において
>中央に配置されてしまいます。(枠からはみ出してしまいます)
サイズを計算するのには、きちんとMergeAreaのサイズを用いていますよね。
これに対して、表示位置を計算する際には、
> (targetCell.Height - Selection.Height) / 2
> (targetCell.Width - Selection.Width) / 2
と、結合セルの左上に当たる単独セルのサイズを基に計算しているために、齟齬が生じているのではないでしょうか?
すみません!解決しました!!
最後の箇所を下記のように修正すると正しく動作しました。
fujillinさんのご指摘のおかげで欠損を見つけることができました。
ありがとうございました。
' 表示位置をセル中央に移動
Selection.Top = targetCell.MergeArea.Top + (targetCell.MergeArea.Height - Selection.Height) / 2
Selection.Left = targetCell.MergeArea.Left + (targetCell.MergeArea.Width - Selection.Width) / 2
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
ハマっている「お菓子」を教えて!
この世には、おいしいお菓子がありすぎて……。 次何を食べたらいいか迷っています。 みなさんが今、ハマっている「お菓子」を教えてください!
-
家・車以外で、人生で一番奮発した買い物
どんなものにお金をかけるかは人それぞれの価値観ですが、 誰もが一度は清水の舞台から飛び降りる覚悟で、ちょっと贅沢な買い物をしたことがあるはず。
-
メモのコツを教えてください!
メモを取るのが苦手です。 急いでメモすると内容がごちゃごちゃになってしまったり、ひどいときには全く読めない時もあります。
-
昨日見た夢を教えて下さい
たまにすごいドラマチックな夢見ること、ありませんか? 起きてからも妙に記憶に残っているような、そんな夢。
-
「お昼の放送」の思い出
小学校から中学校、ところによっては高校まで お昼休みに校内放送で、放送委員が音楽とかおしゃべりとか流してましたよね。 最近は自分でもラジオができるようになって、そのクオリティもすごいことになっていると聞きます。
-
【VBA】写真の縦横比を変えずに貼り付ける
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・ちょっと先の未来クイズ第4問
- ・【大喜利】【投稿~10/21(月)】買ったばかりの自転車を分解してひと言
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・ハマっている「お菓子」を教えて!
- ・最近、いつ泣きましたか?
- ・夏が終わったと感じる瞬間って、どんな時?
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・都道府県穴埋めゲーム
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
vbaで指定したセルより下の行を...
-
エクセルマクロで「セルのサイ...
-
VBAでの SendKeysの変数指定方法
-
Excelでプルダウンからフィルタ...
-
エクセルでセルをクリックする...
-
ファイルサーバー上のexcelファ...
-
マクロのデータ削除
-
結合セル内の値を、結合解除後...
-
セルをクリックしたら色を変え...
-
ダブルクリックでセルに色をつ...
-
VBA ボタンをセルの右側に合わ...
-
EXCELに画像を貼り付けマクロの...
-
Excel VBA:フォーム←→セルのア...
-
Excelマクロ セルを行頭に移動
-
VBA Rangeの足し算
-
【Excel】VBAでメール作成
-
excel マクロでの特殊文字入力方法
-
【VBA】アクティブセルだけ背景...
-
エクセルでスピンボタンとスク...
-
Excel VBA で色付きのセルの値...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
vbaで指定したセルより下の行を...
-
エクセルでセルをクリックする...
-
VBAでの SendKeysの変数指定方法
-
Excel VBA:フォーム←→セルのア...
-
Excelマクロ セルを行頭に移動
-
ファイルサーバー上のexcelファ...
-
マクロのデータ削除
-
セルをクリックしたら色を変え...
-
エクセルマクロで「セルのサイ...
-
(エクセルVBA)セルを左クリッ...
-
Excel VBA で色付きのセルの値...
-
【VBA】アクティブセルだけ背景...
-
IF関数で違う値もTRUEになる
-
Excelでプルダウンからフィルタ...
-
エクセル:セルの色のコード番...
-
EXCEL(VBA) セルをクリックし...
-
excel マクロでの特殊文字入力方法
-
【マクロ】1つのセルから結合...
-
ダブルクリックでセルに色をつ...
-
VBA Rangeの足し算
おすすめ情報
早速のご回答ありがとうございます。
>結合セルの左上に当たる単独セルのサイズを基に計算しているために、
>齟齬が生じているのではないでしょうか?
冒頭の変数定義において、
Dim targetCell As Range とレンジ指定をしているのですが、
これでは、不足しているということでしょうか。
確かにご指摘された箇所で問題が発生しているとは思うのですが。。。