UserFormからの画像挿入　ExcelVBA

Question

ExcelVBAにて質問です。

UserForm
TextBox1,image１,CommandButton1,CommandButton2
があります。

TextBox1＝A列にあるNo

処理内容
パターン１（TextBoxのNoがA列にない場合）
CommandButton1クリック→マイピクチャフォルダ表示→image１に貼付け
CommandButton2クリック→Sheet1のB列の最終行に挿入

パターン2（TextBoxのNoがA列にある場合）
TextBox1にNoを入力→image１にTextBoxのNo＝A列のNoの行にある画像を表示
CommandButton1クリック→マイピクチャフォルダ表示→image１に貼付け
CommandButton2クリック→TextBoxのNo＝A列のNoの行のB列の画像を置換（元あった画像は削除）

このような処理を行いたいです。
どうかご教示よろしくお願いします。

jmuiny · Accepted Answer

Set sh、Set wrが変数の定義がありませんとでましたが、Variant型にとりあえず入れ実行することができました。
どの部分の事でしょうか？

拡張子がPNGなら、JPGの部分を変更するだけですが、
画像が２種類となると複雑になるので、元の画像の拡張子は統一するべきだと思います。

jmuiny · Answer

No.2です。参考までにステップ実行ならうまくいく部分のコードを載せておきます。

OSやバージョン、メモリなど色々な要素が関係していると思うので、貴殿でも一度試してみる価値はあるかと思います。

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim sh As Worksheet
Dim wr As Range
Dim tmp As Variant
Dim shp As Shape
Dim rng As Range
Dim fname As String
Dim flg As Integer
Application.ScreenUpdating = False
If TextBox1.Value = "" Then Exit Sub
Set sh = Worksheets("Sheet1")
Set wr = sh.Range("A1:A" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
tmp = Application.Match(Val(TextBox1.Value), wr, 0)
flg = 0
If IsError(tmp) = True Then Exit Sub
sh.Range("B" & tmp).Select
For Each shp In ActiveSheet.Shapes
Set rng = Range(shp.TopLeftCell, shp.BottomRightCell)
If Not (Intersect(rng, Selection) Is Nothing) Then
If shp.Type = 13 Then 'オブジェクトが画像ならType=13となる。
shp.CopyPicture
fname = "tmp"
ACWidth = shp.Width
ACHeight = shp.Height
Set TCht = ActiveSheet.ChartObjects.Add(0, 0, ACWidth, ACHeight).Chart
TCht.Paste
TCht.Export FileName:=ThisWorkbook.Path & "" & fname & ".jpg", filtername:="JPG"
TCht.Parent.Delete
flg = 1
End If
End If
Next
If flg = 1 Then
Image1.Picture = LoadPicture(ThisWorkbook.Path & "	mp.jpg")
Kill ThisWorkbook.Path & "" & fname & ".jpg"
End If
End Sub

WindFaller · Answer

#1の回答者です。
手をつけるのが遅れてしまいましたが、少し教えていただきたいのは、その画像は、写真などですよね。他の部分はたぶん出来ているような気がしますが、その縦横比などが、ピタリと同じでないといけないわけで、そこがこちらはうまくできていません。完全に原型が崩れてしまいます。

Worksheets("Sheet1").Shapes.AddPicture
で、画像をインポートしましたが、正しい形にならず、失敗を繰り返しています。

それと、パータンで、ワークシート上から、イメージオブジェクト(Image1)にインポートしたものの取りやめて、元に戻すということはありえますでしょうね。

2　の画像をワークシートから抜いて、Image1 に入れたけれども、新しいものを入れないで、戻してしまう、というケースです。

もう少し、こちらは発表までに時間が掛かりそうです。

jmuiny · Answer

No.2です。登録ボタンを下記に変更して下さい。

Private Sub CommandButton2_Click()
Dim sh As Worksheet
Dim tmp As Variant
Dim shp As Shape
Dim rng As Range
Set sh = Worksheets("Sheet1")
tmp = Application.Match(Val(TextBox1.Value), sh.Range("A:A"), 0)
If IsError(tmp) = True Then
tmp = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
sh.Range("A" & tmp).Value = TextBox1.Value
End If
sh.Range("B" & tmp).Select
For Each shp In ActiveSheet.Shapes
Set rng = Range(shp.TopLeftCell, shp.BottomRightCell)
If Not (Intersect(rng, Selection) Is Nothing) Then
shp.Delete
End If
Next
With Worksheets("Sheet1").Range("B" & tmp)
Set objShape = ActiveSheet.Shapes.AddPicture(FileName:=gfile, _
LinkToFile:=False, SaveWithDocument:=True, _
Left:=.Left, Top:=.Top, Width:=.Width * 0.9, Height:=.Height * 0.9)
End With
End Sub

jmuiny · Answer

一部どうしても解決できない部分があり回答できませんでした。
既に存在するNoの場合にユーザーフォームのImageに表示するという部分です。
これは色々調べましたがかなり面倒で、一旦画像を保存してそれをImageに表示という方法しかありませんでした。ただ、これを実際にやってみるとステップ実行では出来るのに、ステップ実行でないと空の画像が表示されるという結果です。

ですので、正しく実行されている部分だけを回答します。

標準モジュールに
Public gfile As String
を定義

画像選択させるボタンのコード
Private Sub CommandButton1_Click()
gfile = Application.GetOpenFilename("画像ファイル,*.jpg")
If gfile = "False" Then Exit Sub
Image1.Picture = LoadPicture(gfile)
End Sub

登録ボタンのコード
Private Sub CommandButton2_Click()
Dim tmp As Long
Dim shp As Shape
Dim rng As Range
tmp = Application.Match(Val(TextBox1.Value), Worksheets("Sheet1").Range("A:A"), 0)
Worksheets("Sheet1").Range("B" & tmp).Select
For Each shp In ActiveSheet.Shapes
Set rng = Range(shp.TopLeftCell, shp.BottomRightCell)
If Not (Intersect(rng, Selection) Is Nothing) Then
shp.Delete
End If
Next
With Worksheets("Sheet1").Range("B" & tmp)
Set objShape = ActiveSheet.Shapes.AddPicture(FileName:=gfile, _
LinkToFile:=False, SaveWithDocument:=True, _
Left:=.Left, Top:=.Top, Width:=.Width * 0.9, Height:=.Height * 0.9)
End With
End Sub

WindFaller · Answer

これは、どこまで出来ているのでしょうか?

何度か、ああでもないこうでもないと読み返してしまいましたが、要領の得ないところがあります。

>TextBoxのNo＝A列のNoの行のB列の画像を置換（元あった画像は削除）
この意味が良く分かりません。[A列のNoの行]とは？
それとも、[A列のNoの行のB列の画像]と読むのでしょうか？

画像に番号が付いているとはいえ、画像はIndex ですから、順序だけしかありません。私なら、Selection で十分な気がします。元の画面はどのようになっているのか、こちらでは想像もつきません。

数字(テキストボックスのNo)で、画像を特定化させるものが何か書かれていないから、分からないのです。

それから、画像は、B列にのみにあるということでしょうか？

パターン2の場合、
>CommandButton1クリック→マイピクチャフォルダ表示→image１に貼付け
>CommandButton2クリック→TextBoxのNo＝A列のNoの行のB列の画像を置換（元あった画像は削除）

B列の一つの画像を削除したら、そこに入れ替えに、マイピクチャーフォルダーから取得した画像と入れ替えするだけでよいのではないでしょうか。つまり、image1 に置く必要があるのでしょうか。それとも、プールしておいてから、削除する画像を選ぶということなのでしょうか。

図とかないと、想像だけでは、内容が伝わっていないように思うのです。

UserFormからの画像挿入 ExcelVBA

Set sh、Set wrが変数の定義がありませんとでましたが、Variant型にとりあえず入れ実行することができました。

No.2です。

#1の回答者です。

No.2です。

一部どうしても解決できない部分があり回答できませんでした。

これは、どこまで出来ているのでしょうか?

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

UserFormからの画像挿入　ExcelVBA