Excel (VBA)

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

 
(Windows 8.1 : Excel 2013)
画像の挿入について
投稿日時: 19/02/01 04:31:51
投稿者: eco2019

お世話になります。
 
写真帳を作りましたが、他のパソコンで見ると画像が表示されていません。
 
試行錯誤でトライアルしながら動いたのですが、どうすればいいのか分かりません。
どこをどう修正すればよいでしょうか。。。宜しくお願い致します。
 
Sub 写真()
Dim Path As String, WSh As Variant
Dim z As String
Dim t As Long
Dim j As Long
 
  Range("A3").Select
  z = Range("A3").Value
 
  Range("A7").Select
  k = Range("A7").Value
   
  Range("C2").Select
 
For t = 2 To Cells(Rows.Count, 2).End(xlUp).Row
  q = Range("B" & t).Value
 
If q <> "" Then
 
  ActiveSheet.Pictures.Insert(z & "\" & k & q & ".JPG").Select
 
  Selection.ShapeRange.Height = 28#
     
  Selection.Cut
  Range("C" & t).Select
  ActiveSheet.Paste
 
  ActiveCell.Offset(1, 0).Select
 
End If
 
  Next t
      
Range("H3").Select
 
End Sub
 

回答
投稿日時: 19/02/01 06:46:29
投稿者: simple

2010から Pictures.Insert では、リンク貼り付けに変更になりました。
このため、リンク元のファイルが無い他のPCでは画像が見えないことになります。
仕様の変更ですから致し方ありません。
 
こちらのサイトの即効テクニックというコーナーを参照して下さい。
http://www.moug.net/tech/exvba/0120020.html
(なお、このコーナーは有益ですから、適宜利用されるとよいでしょう)
 
この他、
 『VBA 画像挿入 リンクなし』等でネット検索すれば
より詳しい解説もあるかと思います。トライしてみて下さい。
例えば AddPicture を使う方法もあります。
https://support.microsoft.com/ja-jp/kb/2396509
 
------------------------
もっと重要な助言は、
逐一、選択しないことです。
 
  Range("A3").Select
  z = Range("A3").Value
最初の Range("A3").Select
は全く不要です。
 
随所で Selectを使っていますが、これらは殆どのケースで
Selectしないで書くことができます。
 
・元々無駄な動作なこと
・コードの読みやすさ、
・処理速度の観点などから、
Selectから脱却することをお薦めします。
 
取り急ぎ、要件のみお伝えしました。
更に詳しい指摘があるかもしれません。

投稿日時: 19/02/02 03:21:35
投稿者: eco2019

simple さん、有難うございます。Selectからの脱却、承知しました。
 
画像のリンク切れを回避するのを選択しようと試みましたが、途中で止まってしまいました。
 
With ActiveSheet.Pictures.Insert(z & "\" & k & q & ".JPG").Select
    .CopyPicture 'クリップボードにコピー
    .Delete '画像をいったん削除
End With
 
あと、保存する時にファイルの種類をExcel97-2003ブック(.xls)にすれば問題は一時的に解消できるのでしょうか。

回答
投稿日時: 19/02/02 04:36:32
投稿者: simple

With ActiveSheet.Pictures.Insert(z & "\" & k & q & ".JPG").Select
    .CopyPicture 'クリップボードにコピー
    .Delete '画像をいったん削除
End With
赤字の部分は何を意図したものでしょうか。
Selectからの脱却、承知しました、のではなかったのでしょうか。
  
With ○○
の、○○のところはなんらかのオブジェクトでなければなりませんが、
その書き方では、条件を満たしていませんからエラーになります。
(ActiveSheet.Pictures.Insert(z & "\" & k & q & ".JPG").Select
  は Nullとなっています。これはオブジェクトではありません)
 
> あと、保存する時にファイルの種類をExcel97-2003ブック(.xls)にすれば問題は一時的に解消できるのでしょうか。
できません。
それはInsertの動作がリンク貼り付けに変わったことに起因しています。
古いブックの形式でもリンク貼り付け機能はあったので、
ファイル形式を変えたところで事情は変わりません。
リンクされたままですから、別のPC上で画像が見つからないようになることに変わりありません。
 
ご自分で試してみてはどうですか?
元の画像の名前を変更してみて、
そのExcel97-2003ブックを開き直して、画像が表示されるかどうか。

回答
投稿日時: 19/02/02 13:18:08
投稿者: simple

たとえば、こんな書き方ができると思います。
 

Sub 写真()
    Dim path     As String
    Dim foldr    As String
    Dim filename As String
    Dim k        As Long
    Dim pic      As Picture
    
    path = Range("A3").Value
    foldr = Range("A7").Value

    For k = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        filename = Range("B" & k).Value
        If filename <> "" Then
            Set pic = ActiveSheet.Pictures.Insert(path & "\" & foldr & filename)
            pic.Height = 28#
            pic.CopyPicture
            pic.Delete
            Range("C" & k).PasteSpecial
        End If
    Next k
End Sub

あえてWithステートメントを使わない書き方にしました。
使わないといけないというものでもないので、間違った使い方をするよりよいかもしれません。
(補足)
拡張子もつけたファイル名にしていますから、必要なら元に戻してください。

投稿日時: 19/02/06 00:00:04
投稿者: eco2019

遅くなり申し訳ございません。
 
メッセージ有難うございます。
 
何とか解決出来ました。