[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Pictures.insertの2順目以降が貼り付けれない』（makoto）
2度目の質問になります。お世話になります。エクセルVBAでセルに書かれた画像ファイル名を取得して、その画像を貼り付け様と思います。
例えば、画像ファイル名リスト 1.jpg 2.jpg 3.jpg 4.jpg
これを以下の内容でループでまわして貼り付け様と思うのですが、最初の1つ目のファイル(ここで言うと1.jpg)は貼り付けできるのですが、2つ目以降のファイルは貼り付けが出来ません。MsgBoxでは、順に1.jpg→2.jpg→3.jpg→4.jpgと値を取得できている事は確認しております。
プログラムの中身
myNo = 1
Filename = Worksheet("リスト").Cells(myNo,1).Value
MsgBox = Filenames
Activesheet.Pictures.Insert(Filenames).select
myNo = myNo + 1
また、リストの順を下記のように変えても、やはりファイル名は取得できているのですが、2.jpgを飛び越して先頭で取得した1.jpgのみ貼り付けされてしまいます。
1.jpg 2.jpg 1.jpg 4.jpg
どこがおかしいのでしょうか？
リストが取得できているのに、2つ目以降が貼り付けれないのはどうしてでしょうか？
どなたかご教授頂けませんか？よろしくお願いいたします
[エクセルのバージョン]
Excel2000
[OSのバージョン]
WindowsXP
ご提示のコードは Sub〜End Sub の間に入れても動きません。 訂正をして、ループ部分も加えると動きます。（Excel2002）
訂正をしたことが動くことになった理由かもしれませんし それ以外の理由があるのかもしれません。 ＞MsgBoxでは、順に1.jpg→2.jpg→3.jpg→4.jpgと値を取得できている と言う事は、訂正以外の問題の様にも思えます。
上記の様な簡易コードで、 実際に動かして確かに上手く行かないものを作成し もう一度載せて下さい。
また、Filenamesをフルパスにしてみると 何か変わるかもしれません。
(HANA)
HANAさんご連絡ありがとうございます。簡単なコードを記載しました。
もしよろしければ、またご指摘いただけませんでしょうか？
Sub harituke()
Dim myDataCnt As Long
Dim myNo As Long
Dim i As Long
Dim myRow As Long
Dim myRow2 As Long
Dim myName As String
Dim myObj As Object
Set myObj = Worksheets("設定").Cells(11, 3)
If myObj Is Nothing Then MsgBox "フォルダーは?"
CreateObject("WScript.Shell").CurrentDirectory = myObj
myDataCnt = Worksheets("設定").Range("C13").End(xlDown).Row
myNo = 13
myRow = 2
Worksheets("picture").Select
Do Until myNo > myDataCnt
myName = Worksheets("設定").Cells(myNo, 3).Value
MsgBox "個数は " & myDataCnt
MsgBox "ファイル名は " & myName
MsgBox "パス名は " & myObj
Cells(myRow, 2).Select
ActiveSheet.Pictures.Insert(myObj & myName).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.Height = 75
Selection.Width = 75
ActiveSheet.Cells(myRow, 3).RowHeight = 75
ActiveSheet.Cells(myRow, 2).ColumnWidth = 12
myRow = myRow + 2
myNo = myNo + 1
Loop
End Sub
こんにちは。かみちゃん です。
横から失礼します。
> 簡単なコードを記載しました。
MsgBox "個数は " & myDataCnt MsgBox "ファイル名は " & myName MsgBox "パス名は " & myObj
の部分を
MsgBox "個数は " & myDataCnt & vbCrLf & _
"ファイル名は " & myName & vbCrLf & _
"パス名は " & myObj & vbCrLf & _
"フルパスは " & myObj & myName
としてみて、特に、myObj & myName の値を確認されてはいかがでしょうか？
C:\Documents and Settings\xxx\My Documents\My Pictures\1.jpg
^^^
などとなっていますでしょうか？
(かみちゃん) 2009-03-08 09:41
ご指摘頂いたように、フルパス表記で確認しましたが、msgbox上は問題なくファイル名をフルパスで取得出来たものを表示しています。 しかし、実際のpictures.insertsの行では、「Picturesクラスのinsertプロパティを取得出来ない。」と表示され、2順目で落ちます。 Msgboxでの表示内容と実際のActiveSheet.Pictures.Insert(myObj & myName).Selectの中身は違うのでしょうか？ 変数か、何かの定義なのでしょうか...。 どなたか、引き続きご指導頂けたら幸いです。
ブックに、「設定」と「picture」というシートを作成し 設定シートの内容は以下の状態 [C] [10] フォルダ名 [11] C:\P\ [12] 画像名 [13] 1001.jpg [14] 1002.jpg [15] 1003.jpg [16] 1004.jpg
Cドライブ直下にPフォルダを作り その中に1001〜1004の名前のJPEG画像をおいて ご提示のコードを動かしましたが 問題なく貼りつきました。(Excel2007) 問題がどこにあるのか分かりませんので、いろいろ書いてみます。
１． どこでも良いですが、D13セルに =HYPERLINK($C$11&C13) の式を入れて、下にフィルドラッグ。 D13セルから下方向へ、該当の画像へのハイパーリンクが設定できますので すべての画像が問題なく開けるか確認してみてください。
２． もしも、他のPCや 階層の深い位置 等に画像がある場合は 念のため、Cドライブ直下に新しくフォルダを作成し フォルダ名も単純なもの（A や B 等）にして やってみてください。 また、テストの際は 画像名も簡単なものを 使用していただけるのが良いと思います。
(HANA)
おじゃまします。
なぜ、最初の一回だけ貼りつくのか？ よく分からないですが、ご提示のコード見ていて 少し気になる点があります。
> Dim myObj As Object
> Set myObj = Worksheets("設定").Cells(11, 3)
> If myObj Is Nothing Then MsgBox "フォルダーは?"
> CreateObject("WScript.Shell").CurrentDirectory = myObj
と[C11]セルをオブジェクトに代入しているのは何のためでしょう？
CurrentDirectoryを変更しなくても、要は、画像ファイル名がフルパスで 指定できればいいと考えれば、 そこは 有効なパス名（文字列）が入っていることをチェックすればいいのでは？
とりあえず、
Dim myPath As String
myPath = Worksheets("設定").Cells(11, 3).Value
If myPath = "" Then
MsgBox "「設定」シート の[C11]に フォルダー名が記入されていません"
Exit Sub
End If
If Right$(myPath, 1) <> "\" Then myPath = myPath & "\" '--- お尻に「\」が付いていなければ「\」を補う
Msgbox myPath & " フォルダ内の画像を貼り付けます"
とか、で確認してみてはいかが？
(kanabun)
こんにちは。かみちゃん です。
> お尻に「\」が付いていなければ「\」を補う
私もそこが怪しいのではないかと思っていて、 2009-03-08 09:41 で確認のコードを提示していますが、
> フルパス表記で確認しましたが、msgbox上は問題なくファイル名をフルパスで取得出来たものを表示しています。
とのことなので、お尻に「\」は補えているのではないでしょうか？
そもそも、
>> Dim myObj As Object
>> Set myObj = Worksheets("設定").Cells(11, 3)
>> If myObj Is Nothing Then MsgBox "フォルダーは?"
>> CreateObject("WScript.Shell").CurrentDirectory = myObj
> と[C11]セルをオブジェクトに代入しているのは何のためでしょう？
は、同感ですね。
(かみちゃん) 2009-03-08 21:43
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.