advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 14722 for VBA ������������ (0.003 sec.)
[[20190605100528]]
#score: 3409
@digest: f45e2550c6450f784a532dac9b4cbd27
@id: 79775
@mdate: 2019-06-05T04:32:53Z
@size: 4947
@type: text/plain
#keywords: insr (21562), ルco (11841), 内頂 (11368), 像自 (10985), ダco (10493), 入画 (8810), 納フ (6892), addpicture (6080), 子" (5971), 動挿 (5602), ダ¥" (5357), 角) (5252), msotrue (4421), pictures (4301), ル" (3744), 画像 (3282), 前述 (3056), pic (2628), shp (2429), msofalse (2274), shapes (1762), 案内 (1745), const (1504), insert (1468), shape (1393), 定セ (1346), target (1301), ク貼 (1298), ファ (1199), 挿入 (1052), activesheet (1034), 左上 (1003)
VBA画像挿入「リンクされたイメージを表示できません」』(たかふみ)
お世話になります。 VBAの画像挿入についてご質問致します。 環境情報(VBA初心者。Excel2016 Win10)VBAは改めて勉強しようと思います・・。 ◆経緯 (1)ネットから探り、「特定のセルが変更(入力)されたとき、別の指定セルに入力された名称と同じ名称の画像を指定のフォルダからエクセルに貼り付けする」という、VBAをエクセルシートに用意。 (2)前述VBAを使ってファイルを複数個別に「xlsx」で保存。 (3)しかし、後日「Pictures.Insert」ではリンク貼り付けになることを知る。 ◆質問 1.前述でリンク貼り付けされた画像を、通常の画像として修正できないでしょうか。(2)によって既に幾つかファイルが独立しているためです。 2.「Pictures.Insert」を別の方法で、画像として貼り付けできないでしょうか。条件は、貼り付けセル位置と、縦横サイズが指定です。 下記、使用したコードです。 ---- Private Sub Worksheet_Change(ByVal Target As Range) '画像自動挿入だけど関数は無効 Const trgR As String = "セル" '地図通し番号を入力するセル Const insR As String = "セル" '挿入画像の左上のセル Const path As String = "¥¥フォルダ¥" 'ファイルの格納フォルダ Const pic As String = ".jpg" '「.(半角)」+ファイルの拡張子" Dim shp As Shape Dim buf As String If Target.Address(0, 0) = trgR Then For Each shp In ActiveSheet.Shapes '既に表示されている画像を削除する処理 If Not Intersect(Range(insR), Range(shp.TopLeftCell, _ shp.BottomRightCell)) Is Nothing Then shp.Delete End If Next Range(insR).Select buf = Dir(path & Target.Value & pic) If buf <> "" Then '入力したファイル名があるかチェック ActiveSheet.Pictures.Insert (path & Target.Value & pic) Else MsgBox "指定したファイルがありません" End If End If Target.Offset(1, 0).Select End Sub ---- どうぞ宜しくお願い致します。 ※VBAを作る際に参考させていただいた質問があったのですが、失念してしまいました。 < 使用 Excel:Excel2016、使用 OS:Windows10 > ---- ActiveSheet.Shapes.AddPicture を使ってみてください。 第2引数にmsoFalse(リンクしない)、第3引数にmsoTrue(ブックと一緒に保存)を指定すれば良いです。 (???) 2019/06/05(水) 11:21 ---- コメントありがとうございます。 ご案内頂いた「ActiveSheet.Shapes.AddPicture」調べてみました。 表面上は分かったのですが、前述のVBAを変更する際に、「指定セルが変更された場合」「セル内の値を参照に用いて引っ張るファイル名を指定」「既に表示された画像を削除処理」など、 どこをどう変えるべきか、理解できませんでした..。(応用できない) 全くのド素人で申し訳ないですが、ご教示いただけないでしょうか。 ※参考にしたサイト「https://tonari-it.com/excel-vba-shapes-addpicture/」 (たかふみ) 2019/06/05(水) 11:43 ---- VBAのお勉強で作ってみました(^^) 自分の環境下では動きましたが…(Excel2010、windows7) ↓参考にしたサイト https://www.moug.net/tech/exvba/0120020.html Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) '画像自動挿入だけど関数は無効 Const trgR As String = "セル" '地図通し番号を入力するセル Const insR As String = "セル" '挿入画像の左上のセル Const path As String = "¥¥フォルダ¥" 'ファイルの格納フォルダ Const pic As String = ".jpg" '「.(半角)」+ファイルの拡張子" Dim shp As Shape Dim buf As String Dim mypic As Shape '追加 If Target.Address(0, 0) = trgR Then For Each shp In ActiveSheet.Shapes '既に表示されている画像を削除する処理 If Not Intersect(Range(insR), Range(shp.TopLeftCell, _ shp.BottomRightCell)) Is Nothing Then shp.Delete End If Next Range(insR).Select buf = Dir(path & Target.Value & pic) If buf <> "" Then '入力したファイル名があるかチェック ' ActiveSheet.Pictures.Insert (path & Target.Value & pic) Set mypic = Me.Shapes.AddPicture(Filename:=path & Target.Value & pic, _ linktofile:=msoFalse, _ savewithdocument:=msoTrue, _ Left:=Range(insR).Left, _ Top:=Range(insR).Top, _ Width:=0, _ Height:=0) With mypic .ScaleHeight factor:=1, relativetooriginalsize:=msoTrue .ScaleWidth factor:=1, relativetooriginalsize:=msoTrue End With Else MsgBox "指定したファイルがありません" End If End If Target.Offset(1, 0).Select End Sub (虎) 2019/06/05(水) 12:02 ---- コメントを有難うございます。 ご案内頂いたコードで無事挿入できました。 お勉強ついでに、とのことですが元まで流用いただき非常に助かりました!! ???様、虎様、ご回答いただきどうも有難うございました。 今後とも宜しくお願い致します。 (たかふみ) 2019/06/05(水) 13:32 ...
http://www.excel.studio-kazu.jp/wiki/kazuwiki/201906/20190605100528.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97018 documents and 608145 words.

訪問者:カウンタValid HTML 4.01 Transitional