Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8 : Excel 2013)
写真帳に写真を貼り付けるには。
投稿日時: 19/07/13 20:55:08
投稿者: eco2019

いつもお世話になっております。
 
別シートに写真を貼り付けたいです。
 
一覧表のセルW6〜 に写真名があり、Sheet1の
F4,Q4,F22,Q22(1ページ),F45,Q45,F63,Q63(2ページ)・・・・・
セルは結合されています。
 
この部分に写真が貼り付けられればと思います。
 
Sub test1()
 
Dim Path As String, WSh As Variant
Dim z As String
Dim t As Long
 
On Error Resume Next
z = Range("W1").Value
 
For t = 6 To Cells(Rows.Count, 23).End(xlUp).Row
 
  q = Range("W" & t).Value
 
If q <> "" Then
 
  ActiveSheet.Pictures.Insert(z & "\" & q & ".JPG").Select
 
  Selection.ShapeRange.Height = 170#
 
Sheets("Sheet1").Select
     
  Selection.Cut
   
  Cells(t - 2, 6).Select
   
  ActiveSheet.Paste
 
  ActiveCell.Offset(0, 11).Select
   
Sheets("一覧表").Select
 
End If
 
  Next t
      
Range("H3").Select
 
End Sub
 
https://gyazo.com/9c5754201e4eedebc0ce6256bdd9b765
 
https://gyazo.com/14683125520c8aa62b92231c5bc85f69

回答
投稿日時: 19/07/13 21:22:44
投稿者: simple

いくつか投稿上のお願いを書きます。
 
https://www.moug.net/faq/kiyaku.html

引用:
禁止事項
ファイルを直接ダウンロードさせる
ファイルを直接リンクするURL、および同様のファイルをダウンロードさせることを
目的としたフォルダやディレクトリ、サイトへのURLを、Q&A掲示板の発言内に記載
することはご遠慮ください。
一般操作の説明は、操作方法または数式を記載し、マクロに関してはVBAコードを
記載するようにしてください。
とされています。
上記事項のココロは、以下のことでしょう。
・セキュリティを懸念して読まない方針の方もいます。
・また、外部のリソースに依存すると、それが消滅したときに、質問が意味をなさなくなります。
  質問者だけでなく閲覧者のこともお考え頂きたい。
 
------
モジュールの先頭に
Option Explicit
として、未宣言の変数が無い状態で投稿願います。
-------
インデントを付けて下さい。
これは相手に対するというよりも、ご自分のためにも必要なことです。
-------
最後に、これが重要なことですが、
(できているのはどこまでで、)具体的に詰まっているところ(質問の核心)は
なにかを言葉で説明してください。
回答者に読み解けというのは酷ですし、マナーだと思います。
 
何度か質問されている方なので納得は頂けると思いますが、上記よろしくお願いします。
確認したい内容もありますが、まずは上記から。

回答
投稿日時: 19/07/13 21:35:18
投稿者: WinArrow
投稿者のウェブサイトに移動

掲示のコードでは、どのような問題があるのでしょうか?

投稿日時: 19/07/13 21:59:54
投稿者: eco2019

大変、申し訳ございません。承知致しました。

投稿日時: 19/07/14 05:15:02
投稿者: eco2019

WinArrow さんの引用:
掲示のコードでは、どのような問題があるのでしょうか?

色々やって写真を貼り付けるところまでは出来ましたが、セルを移動するところがよく分かりません。すみません。
 Cells(t - 2, t).Select
  ActiveSheet.Paste
  ActiveCell.Offset(0, 5).Select

回答
投稿日時: 19/07/14 08:01:56
投稿者: WinArrow
投稿者のウェブサイトに移動

図形貼付けに関するアイデアを紹介します。
  
 (1)図形は、セルの属性にはならないということ
  図形は、セルの上に乗っかっているだけで、セルの属性ではないということを理解してください。
   例えば、
      With Sheets("AAA")
            With .Range("B1")
                Debug.Print .Font.Size
            End With
       End With
       という記述はできるが
      With Sheets("AAA")
            With .Range("B1")
                Debug.Print .Shapes("図形1").Name
            End With
       End With
      という記述はできません。
    但し、図形を貼り付ける場合、どこに置くか?という意味では、セルのアドレスは必要です。
  
 (2)Offsetの使い方
   セルを結合した状態で、Offsetを使った場合、
   参照セルがイメージと異なる場合があるということです。
  
  例、次のコードを実行してみてください。
   あなたがイメージしたセルを参照することになりますか?
   コード前提条件
    セル:B3〜E3まで4つのセルを結合しています。
    セル:B4〜E4のセルは結合うされていません。
    B3から4つ右のセルを参照
    B4から4つ右のセルを参照
 

   Sub test()
          Debug.Print Range("B3").Offset(0, 4).Address
          Debug.Print Range("B4").Offset(0, 4).Address
     End Sub

 
   
   もし、セルに1つの図形を乗せると考えるならば、
    セル幅、行高を図形のサイズまで広げて1つのセルにした方がわかりやすいでしょう。
    もう一つは、
    図形を貼り付ける場合、事前にその図形を置く場所を認識させる必要があります。
    そのためには、セルを選択しておく・・・という考え方になるが、
    常に、シートの左上(A1セル)に貼り付け、目的の場所に移動させる
   という考え方をすると、
       セルを「Select」する、
       セル結合
       セルのサイズを図形に合わせる
      などという面倒なことを考える必要がなくなると思います。
 
    ※特に必要とする以外は、シートやセルの「Select」は使わないこと。
  

回答
投稿日時: 19/07/14 10:39:42
投稿者: WinArrow
投稿者のウェブサイトに移動

図形の読込と任意のセル位置への移動のコード例
 
Sub test()
    With ActiveSheet
        .Range("A1").Select 'どこでもよい
        .Pictures.Insert ("画像ファイルのパス")
        With .Shapes(.Shapes.Count)
            .Top = .Parent.Range(移動先セル).Top
            .Left = .Parent.Range(移動先セル).Left
            .Height = .Parent.Range(移動先セル).Height
        End With
    End With
End Sub

回答
投稿日時: 19/07/14 10:46:32
投稿者: WinArrow
投稿者のウェブサイトに移動

一覧表シートと画像貼付けシートは、べつなんですね・・・
 
その場合、シートを「SELECT」する方法ではシートの切り替えが発生します。
画像ファイル名を取得するのにシート切替するのは、時間のロスです。
 
配列変数に格納すれば、シートの切り替えは不要になります。

投稿日時: 19/07/14 15:43:13
投稿者: eco2019

WinArrowさん、有難うございます。配列変数というのがあるんですね。シートを切り替えが必要ないのですね。
 
画像を貼り付けるのに時間がかかるのは、シートの切り替えのロスが大きかったのですね。

回答
投稿日時: 19/07/14 20:22:02
投稿者: simple

すでに指摘がありましたことと一部重なりますが、追記します。
 
・画像の縦横比は崩れても、シートの対象範囲に合わせるのか、
・縦横比は保存したまま、シートの対象範囲に収まる最大の大きさにするのか
によって変わってきます。
 
これらについては、
Pictures.Insertを使った方法に関する下記記事を参照してください。
https://www.moug.net/tech/exvba/0120027.html
 
また、Pictures.Insertは、Excel2010以降は、リンク貼付に変更になっています。
リンク貼付ではなく、ファイルに画像情報を持たせるには、
下記の後半部分を参照してみてください。
(画像コピー、画像削除、シートに貼付の順の作業をします。)
https://www.moug.net/tech/exvba/0120020.html

回答
投稿日時: 19/07/14 20:40:38
投稿者: WinArrow
投稿者のウェブサイトに移動

>配列変数というのがあるんですね
 
配列変数というのは、
例えば
変数名を「AAA」として配列で宣言すると
Dim AAA(1 To 10)
と記述すると、10個の箱が用意できます。
 
何番目の箱を参照するかを「添え字」で指定します。
添え字も変数で定義します。
Dim AAA(1 To 10),x As Long
xが添え字です。
 
箱の中に、値を格納する方法。
For x = 1 To 10
   AAA(x) = Cells(x,"A").value
Next
と記述するとセルA1〜A10までの値が変数:AAAに格納されます。
 
参照方法
For x = LBound(AAA) To UBound(AAA)
    Cells(x, "B").Value = AAA(x)
Next
と記述すると、変数AAAをセルB1〜B10に転記できます。
 
以上が基本的な概念です。
 
箱の数が固定ならば、静的の定義できますが、
データの個数が可変な場合は、
「()」の中の個数を動的にする方法があります。
変数宣言は
Dim AAA
とだけ記述しておきます。
例えば、列の中のデータが入っている行まで
という場合は、
x = Range("A" & Rows.Count).End(xlUp).Row
で最終行を取得します。
箱の個数を決める
ReDim AAAA(1 To x)
とい記述するとセルA1〜Axまでのデータを格納する箱が用意できます。
格納方法は、
For x = 1 To x
とします。
参照方法は前述のとおり
 
もう一つの格納方法(記述としてはこちらの方がラクチンです
 
Dim AAA
 
AAA = Range("A1:A" & x).Value
これで格納できます。
しかし、シートはもともと2次元テーブルですから、配列変数も2次元で格納されます。
従って、参照時には
Cells(x, "B").Value = AAA(x, 1)
というように2次元で記述する必要があります。
 
 
 
以上、参考にしてください。
 
追伸
 
冒頭のコードを眺めていたら、然るべき変数が宣言されていませんね。
モジュールの先頭に
Option Explicit
を記述しておくと、定義されていない変数のチェックをしてくれます。
また、
>On Error Resume Next
のコードは、エラーがでても無視する
という意味のコードなので、コメントアウトした方がよいです。
解決しなければいけないエラーなのに、見逃してしまいます。
 
 

投稿日時: 19/07/15 03:26:32
投稿者: eco2019

Pictures.Insertのリンク貼付の変更、有難うございます。
今、変数の宣言を強制するにチェック入れました。
配列変数、On Error Resume Next の方も詳しく分かり易く教えていただき有難うございます。

回答
投稿日時: 19/07/15 06:21:19
投稿者: simple

アプローチ方法として、
(1)まず、1つの写真を対象に、
  セル位置に挿入することを先行して完成させる。
(2)それができてから、複数のものを繰り返しで実行する。
 
ということを考えたらよいと思います。
 
> 一覧表のセルW6〜 に写真名があり、Sheet1の
> F4,Q4,F22,Q22(1ページ),F45,Q45,F63,Q63(2ページ)・・・・・

ということからすると、
 
W6の写真は F4:Q22 に挿入
W7の写真は F45:Q63 に挿入
以下、同様に1列に挿入していくということでいいんですか?
 
まず、W6の写真は F4:Q22 に挿入するコードを完成してはどうですか?

投稿日時: 19/07/15 08:30:32
投稿者: eco2019

simpleさん、どうも有難うございます。そうですね、1つずつですね。
 
W6の写真は F4:L16
W6の写真は Q4:W16 に挿入です。
 
W6の写真は挿入できましたので、先が見えそうです。

回答
投稿日時: 19/07/15 08:59:27
投稿者: WinArrow
投稿者のウェブサイトに移動

疑問点
 

引用:

一覧表のセルW6〜 に写真名があり、
Sheet1のF4,Q4,F22,Q22(1ページ),F45,Q45,F63,Q63(2ページ)・・・・・
セルは結合されています。

ということから、画像貼付け位置が縦方向に移動していくと推測されます。
 
しかし
画像貼付け後
引用:

ActiveCell.Offset(0, 11).Select

と次回の貼付け位置を設定していますが、
このコードは横方向に移動するコードではないでしょうか?
 
ActiveCellが「F6」だとすると
横に11シフトするので「6+11」→「Q4」になります。
これで、貴方の意図したセルになるのか?キチンと検証してみましょう。
 
simpleさんの提案を参考にして
まず、1つの画像貼付けを確実にすることから、複数の画像に進んでいく方法で
余りコードを修正することなく進めていく方法を紹介します。
 
2つのプロシジャを作成します。
Option Explicit
 
 
Public Sub 単独画像貼付(ByVal 画像ファイル名 As String, ByVal 貼付けセル As Range, ByVal シート名 As String)
 
    With Sheets(シート名)
         .Range("A1").Select 'どこでもよい
        .Pictures.Insert (画像ファイル名)
         With .Shapes(.Shapes.Count)
             .Top = .Parent.Range(貼付けセル).Top
             .Left = .Parent.Range(貼付けセル).Left
             .Height = .Parent.Range(貼付けセル).Height
         End With
     End With
End Sub
 
 
Sub 単独画像TEST()
     
    Call 単独画像貼付(画像ファイル:="画像ファイルのパス", _
                        貼付けセル:=Range("F4:Q22"), _
                        シート名:="Sheet1")
  
End Sub
 
これで、単独画像貼付けが完成したら
「単独画像TEST」プロシジャを
画像ファイルの個数分ループする形に変更します。
 
 

投稿日時: 19/07/15 09:09:32
投稿者: eco2019

WinArrowさん、有難うございます。
Sheet1のF4の次は、右方向のQ4になるため、(0, 11).Select を使ってみました。
それから、下の縦方向とZ形に配置となります。
 
参考に有難うございます。

回答
投稿日時: 19/07/15 10:27:25
投稿者: WinArrow
投稿者のウェブサイトに移動

eco2019 さんの引用:

WinArrowさん、有難うございます。
Sheet1のF4の次は、右方向のQ4になるため、(0, 11).Select を使ってみました。
それから、下の縦方向とZ形に配置となります。
 
参考に有難うございます。

 
そうですか・・・・
そうすると
>Sheet1のF4,Q4,F22,Q22(1ページ)
と矛盾しないのかな?
 
それから
セル範囲を結合した場合と、結合しない場合の
Offsetの使い方について、検証してみましたか?
 
Offsetだけが移動先指定する方法ではないので、
Offsetにこだわる必要もないと思います。

回答
投稿日時: 19/07/15 10:50:34
投稿者: WinArrow
投稿者のウェブサイトに移動

>右方向のQ4になるため、(0, 11).Select を使ってみました。
についての追加質問。
 
Offsetを使っているので、
多分、貴方が意図したセルに移動しないとは思いますが、
「Q4」セルは、結合したセルの範囲内ですよね・・・
結合したセル内に移動すると考えているのですか?

投稿日時: 19/07/15 11:10:18
投稿者: eco2019

WinArrow さんの引用:
>
「Q4」セルは、結合したセルの範囲内ですよね・・・
結合したセル内に移動すると考えているのですか?

「Q4」セルは、結合したセルの範囲内です。一番最初のセルだけを記載しましたので、すみません、誤解を与えました。セル範囲を結合した場合と、結合しない場合の
Offsetの使い方について、最初にどちらも検証してみましたが、どちらも変化がなかったかと思います。

回答
投稿日時: 19/07/15 11:24:23
投稿者: simple

思います、では不十分です。

Sub test3()
    Dim r As Range
    
    Set r = [A1:C2]
    r.Merge
  
    Debug.Print [A1].Offset(0, 5).Column
    Debug.Print [A10].Offset(0, 5).Column
End Sub

を確認してみては? 明確に差が出ますよ。
ちなみに、[A1]は Range("A1")の省略形です。

回答
投稿日時: 19/07/15 11:30:10
投稿者: simple

ズレることはズレるが、移動先がまた結合セルだから表面化しないということかな。

回答
投稿日時: 19/07/15 12:00:50
投稿者: WinArrow
投稿者のウェブサイトに移動

eco2019 さんの引用:

一番最初のセルだけを記載しましたので、すみません、誤解を与えました。
セル範囲を結合した場合と、結合しない場合の
Offsetの使い方について、最初にどちらも検証してみましたが、どちらも変化がなかったかと思います。

 
こちらでテストした状況を掲示します。
 
前提条件
Range("F4:Q22")を結合しています。
この状態で次のコードを実行すると
Sub test()
    With ActiveSheet
        .Range("F4").Select
        ActiveCell.Offset(0, 11).Select
        Debug.Print ActiveCell.Address
    End With
End Sub
移動先セルは、
$AB$4
となりますが・・・・・
どこか間違っていますか?

回答
投稿日時: 19/07/15 12:15:13
投稿者: simple

WinArrowさん、こんにちは。
19/07/15 08:30:32 投稿者: eco2019
によると

引用:
W6の写真は F4:L16
W6の写真は Q4:W16 に挿入です。

ということらしいので、(2行目のW6はW7のミス)
結合されているセルは、
F4:L16 と Q4:W16 なんでしょう。
その環境下では、結果的に同じQ4セルがActiveになるということなのでしょう。
 
To:質問者さん
それにしても、
引用:
一覧表のセルW6〜 に写真名があり、Sheet1の
F4,Q4,F22,Q22(1ページ),F45,Q45,F63,Q63(2ページ)・
のどこから L16なんていうことがでてくるのか、
一番重要なところを手抜きしているから、
おたがいこうした無駄な時間を費やしてしまうことになる。

投稿日時: 19/07/15 12:39:49
投稿者: eco2019

引用:
移動先セルは、
$AB$4
となりますが・・・・・
どこか間違っていますか?

Q4セルがActiveになり、間違ってはおりません。
分かりにくいと思い最初にスクリーンショット先を書き込んだのですが、
説明だけでの伝え方にせずに説明不足でお手間を取らせて申し訳ございません。

回答
投稿日時: 19/07/15 13:46:58
投稿者: simple

私の 19/07/15 11:30:10 の発言は
ミスリーディングでした。
結果よければ問題ないということでもない。
たまたまの僥倖だったのです。
仮にQ4からでなくP4から始まっていれば
結果はP4になりません、たぶん。
今後のためにも結果オーライでなく
メカニズムをよく理解されることを
お勧めします。

回答
投稿日時: 19/07/15 13:55:16
投稿者: simple

結合されている対象範囲の列数がもっと多ければ、
のほうが適切でした。失礼。

回答
投稿日時: 19/07/15 14:06:34
投稿者: WinArrow
投稿者のウェブサイトに移動

>Q4セルがActiveになり、間違ってはおりません。
そうですか・・・・
重要な説明をキチンとしましょう。
私が
>稿日時: 19/07/15 08:30:32の
レスを見逃してしまったことで、ずいぶん空回り・・・・
 
でも
結合セルの範囲がF4:L14だとしても
Ac「tiveCell.Offset(0,11)
は、「Q4」にはなりませんが・・・
私の環境(Excel2007)では、「W4」になります。
 
バージョンによってちがう?
 
 
 
 

回答
投稿日時: 19/07/15 14:20:16
投稿者: WinArrow
投稿者のウェブサイトに移動

どうでもよい質問ですが、
なぜ、セルを結合させているのですか?
 
前レスでも、書きましたが
画像はセルの上に載っているだけなので、セルの中に入っていません。
それはセルを結合しても結合しなくても同じことです。
 
分かりやすくするならば、セル幅、行高をお望みにサイズに設定し、
そのセル内に画像を貼り付けると、見た目にセルに入っているように見えます。
くどいようですが、結合セルに対するOFFSETの心配もなくなります。
そして、画像のサイズ調整は、高さを
>Selection.ShapeRange.Height = 170#
のようにリテラルで記述するのではなく、
Selection.ShapeRange.Height = ActiveCell.Height
とすれば、設計変更時はセルのサイズを変更するだけで対応可能です。

回答
投稿日時: 19/07/15 14:37:55
投稿者: WinArrow
投稿者のウェブサイトに移動

かなり説明が不足しています。
 
セルの結合範囲の説明から、判断すると
1つ目の画像は、1ページ目に
2つ目の画像は、2ページ目に
貼り付けると解釈できます。
 
しかるに、Offsetを使って横方向に移動させている
 
説明とコードの内容が違がっていると、
回答者とのキャッチボールが増えるのは、当たり前ですが、
なかなか、質問者の意図した方向に進まない・・・きっと歯がゆい思いをしていると思いますが、
整理して、再度、キチンとした説明をしていただけませんか?
暖簾に腕押しのような状態が続くようならば、退散しますが・・・

回答
投稿日時: 19/07/15 15:28:26
投稿者: WinArrow
投稿者のウェブサイトに移動

Offsetの使い方に関する質問の終了
 
私が書いたs前提条件にぬけがありました。
 
結合セルは、F4:L16と Q4:W16
なので、前半のF4:L16だけでテストしていました。
後半の、 Q4:W16を追加すると、
確かに、Offset(0,11)では、ActiveCellは、「Q4」になります。
これは、計算上は、W4ですが、Q4:W16が結合されているため、左上のセルがアクティブになるからです。
 
このメカニズムを市理解して使っているのであれば、かなりスキルがあると思われます。
 
simpleさんのレスにもあるように結果オーライではなく、
メカニズムをきちんと理解しないと、他の場面で悩むことになります。
結合セルに対して、OFFSETの使用す場合は、
かなり注意していても、うっかり使ってしまうことがあり、「何で?」と悩むこと多々あります。
 
Offsetを使用しない記述方法
     With ActiveSheet
         .Range("F4").Select
         .Cells(4, ActiveCell.Column + 11).Select
         Debug.Print ActiveCell.Address
     End With
正真正銘のQ4セルになります。
 

回答
投稿日時: 19/07/15 19:53:51
投稿者: simple

私の19/07/15 13:46:58と19/07/15 13:55:16 は、寝言でした。(外出散歩中につきご容赦)
結合セル間の間隔も、結合セルの列数も無関係でした。
どうであっても、次の結合セルの最終列(この例ではW4)になるのでした。
 
すでに終了宣言がされていますが、上記の私の勘違いの関係もあり、
図示するとこんな風なことです。

F4                    Q4          W4
↓                    ↓          ↓ 
■■■■■■■□□□□■■■■■■■
●--------------------●               非結合のときのOffset(0,11) はQ4

○○○○○○○--------------------○   結合セルのときのOfffset(0,11) はW4
                   Offset(0,11)        ただし、W4をSelectした瞬間に ActivecellはQ4になる。

回答
投稿日時: 19/07/15 20:00:48
投稿者: simple

こんなふうに写真を挿入したいということですね。
     W6セルの写真は、F4:L16 に
     W7セルの写真は、Q4:W16 に
     W8セルの写真は、F22:L34 に
     W9セルの写真は、Q22:W34 に
     以下同様。
      
コードの一例を示します。

Option Explicit
Dim ws    As Worksheet
Dim wsPic As Worksheet

Sub test()
    Dim picFile As String
    Dim r       As Long
    Dim c       As Long
    Dim k       As Long
    Dim rng     As Range
    
    Application.ScreenUpdating = False
    
    Set ws = Worksheets("一覧表")
    Set wsPic = Worksheets("写真")
    
    For k = 6 To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
        picFile = ws.Cells(k, "B").Value    'フォルダ名を補う必要があるかも
        r = (k - 6) \ 2
        c = (k - 6) Mod 2
        
        '写真挿入先セル範囲
        Set rng = wsPic.Cells(4 + 18 * r, 6 + 11 * c).Resize(13, 7)
        Call insertPicture(picFile, rng)    '写真を挿入
    Next
    
    Application.ScreenUpdating = True
End Sub

Private Sub insertPicture(picFile As String, target As Range)
    Dim rX As Double, rY As Double
        
    With wsPic.Pictures.Insert(picFile) '画像を挿入
        rX = target.Width / .Width
        rY = target.Height / .Height
        If rX > rY Then
            .Height = .Height * rY
        Else
            .Width = .Width * rX
        End If
        
        'セルの左上に寄せて配置
        .Left = target.Left
        .Top = target.Top

        'セルの中央(横方向/縦方向の中央)に配置
        '.Left = target.Left '+ (target.Width - .Width) / 2
        '.Top = target.Top '+ (target.Height - .Height) / 2
    End With
End Sub

下のコードはmougの即効テクニックのコードをほぼ引用しています。(URLは上記記載済み)

投稿日時: 19/07/15 23:14:00
投稿者: eco2019

大変遅くなりました。WinArrowさん、 simpleさんどうも有難うございます。
 
セルを結合しているのは、写真がそこに入るからそのような様式になっています。
 
Offfset(0,11)、よく分かりました。コードの例も有難うございます。
 
やってみます。お世話になりました。