- ベストアンサー
VBAの修正に関する質問
- VBAで作成した写真の一括貼り付けプログラムが、他のPCでは正常に動作しない問題が発生しています。知人にも解決策が分からず困っています。
- 写真をアルバムに貼り付ける際に、セルの結合を利用しています。また、フォルダ内の写真を番号順に並べて貼り付ける機能も実装しています。
- 修正のご指導をお願いします。また、フォルダの選択や画像の削除も行えるようにしています。
- negirom
- お礼率33% (1/3)
- Excel（エクセル）
- 回答数3
- ありがとう数1
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
答えを回答するとすれば、こんな感じかな～。 以下の2ヶ所を変更しています。 「'▼修正箇所(1)▼ ～ '▲▲▲▲▲▲▲」 「'▼修正箇所(2)▼ ～ '▲▲▲▲▲▲▲」 （変更前のコードはコメントアウトしています） (1)箇所目はNo1で記述したAddPictureを利用する方法に変更 (2)箇所目は質問コードの縦横比率の保持処理が変だったので修正 あと質問のエラーについてはmyFがVariantだからです。 ファイルパスをCstrで文字列へ変換すればエラー回避できるかと。 （修正(1)に含みます） 【追記】 エクセルのVBAは型宣言を省略しても動作しますが、 宣言しないで使用すると変数の型が混雑しますので やはり宣言はしたほうがよいかと。（今回はしていませんが） No2の方がおっしゃっていますが、先頭にTAB入れてても OKWebに張り付けると先頭の空白行は無視されるんですよね（；_； （よって今回コードも詰まっていますが、ご愛嬌。） ■以下修正後のコードです入替えてください Sub 画像貼り付け() '===============フォルダ選択 Set myPath = CreateObject("Shell.Application") _ .BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, 0) If myPath Is Nothing Then Exit Sub If myPath.Items Is Nothing Then Exit Sub If myPath.Items.Item Is Nothing Then Exit Sub フォルダ = myPath.Items.Item.Path Set myPath = Nothing '===============画像の掃除 ' For Each mySP In ActiveSheet.Shapes ' myAD1 = mySP.TopLeftCell.MergeArea.Address ' myAD2 = Target.Address ' If myAD1 = myAD2 Then mySP.Delete ' Next 元シト = ActiveSheet.Name セル = Array("C4", "AO4", "C21", "AO21", "C38", "AO38", "C55", "AO55") i = 8 Set myFS = CreateObject("Scripting.FileSystemObject") For Each myF In myFS.GetFolder(フォルダ).Files myEXT = LCase(myFS.GetExtensionName(myF)) If myEXT = "jpeg" _ Or myEXT = "jpg" _ Or myEXT = "gif" _ Or myEXT = "tiff" _ Or myEXT = "bmp" _ Or myEXT = "png" _ Or myEXT = "tif" Then If i > 7 Then i = 0 Sheets(元シト).Copy after:=Sheets(Sheets.Count) End If '===============画像の貼り付け '▼修正箇所(1)▼ Set mySP = ActiveSheet.Shapes.AddPicture(CStr(myF), False, True, 0, 0, 0, 0) mySP.ScaleHeight 1, msoTrue mySP.ScaleWidth 1, msoTrue 'Set mySP = ActiveSheet.Pictures.Insert(myF) '▲▲▲▲▲▲▲ myMA = Range(セル(i)).MergeArea.Address '===============タテヨコの縮尺を保持 '▼修正箇所(2)▼ myHSP = mySP.Height / mySP.Width myHMA = Range(myMA).Height / Range(myMA).Width If myHMA >= 1 Then mySP.Width = Range(myMA).Width If myHSP < myHMA Then mySP.Height = mySP.Width * myHSP Else mySP.Height = mySP.Width * myHMA End If Else myHSP = mySP.Width / mySP.Height myHMA = Range(myMA).Width / Range(myMA).Height mySP.Height = Range(myMA).Height If myHSP < myHMA Then mySP.Width = mySP.Height * myHSP Else mySP.Width = mySP.Height * myHMA End If End If 'myHH = Range(myMA).Height / mySP.Height 'myWW = Range(myMA).Width / mySP.Width 'If myHH > myWW Then ' mySP.Height = Range(myMA).Height ' mySP.Width = Range(myMA).Width 'Else ' mySP.Height = Range(myMA).Height ' mySP.Width = Range(myMA).Width 'End If '▲▲▲▲▲▲▲ '===============中央へ調整 myHH2 = (Range(myMA).Height / 2) - (mySP.Height / 2) myWW2 = (Range(myMA).Width / 2) - (mySP.Width / 2) mySP.Top = Range(myMA).Top + myHH2 mySP.Left = Range(myMA).Left + myWW2 Set mySP = Nothing i = i + 1 End If Next Set myFS = Nothing End Sub
その他の回答 (2)
- satoron666
- ベストアンサー率28% (171/600)
http://www.excel.studio-kazu.jp/kw/20100520162047.html 同じ質問？ 当方、Excel2003のため とりあえず、1行1行ステップイン[F8」で確認。 データが全てちゃんと入っているか、下のウィンドウで確認して下さい。 myFにしっかりした値が入っていないということが考えられそうです。 Tabで分けてもらわないと、プログラムが見難いです。 １. しっかり変数定義がされていない。 全部全部そうですが、どこに定義されてるんです？ Dim ●● As String とか。 2013は変数定義は必要ないということで？ ２． If のあと、 End IF で閉じられてない。 If myPath Is Nothing Then Exit Sub の後とかもそうですが どこにEnd if があるんですか？ これで、エラーが出ないというのもおかしな話。
- eden3616
- ベストアンサー率65% (267/405)
エクセルのバージョンで2010から「Pictures.Insert」を用いて画像を挿入した場合 リンク貼り付けになるように仕様がかわりました。 http://support.microsoft.com/kb/2396509/ja http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14110403934 AddPicture（LinkToFileをFalseにする必要事）を用いて画像を挿入してください。 詳しくは参考URLをご覧ください。
お礼
本当に！本当に！感謝！感謝！ありがとうございます！m(_ _)m 本来であれば自分で勉強をして、理解して作業をしなければいけないこと思いますが・・・できません。＾＾； 知人も過去にどこかのサイトから引っ張ってきて作った様で理解もしていません。－－； そうは言っても仕事で非常に重宝しており困っていました。 本当に『教えて！』の目的そのもののご回答をいただきました。 他力本願で非常によくないことは感じていますが・・・・＾＾； 兎にも角にも本当にありがとうございました！m(_ _)m 失礼承知で、また質問させて頂く事もあるかと思います。よろしくお願いいたします。＾＾/