重要なお知らせ

「教えて! goo」は2025年9月17日(水)をもちまして、サービスを終了いたします。詳細はこちら>

電子書籍の厳選無料作品が豊富!

ExcelVBAにて質問です。

UserForm
TextBox1,image1,CommandButton1,CommandButton2
があります。

TextBox1=A列にあるNo

処理内容
パターン1(TextBoxのNoがA列にない場合)
CommandButton1クリック→マイピクチャフォルダ表示→image1に貼付け
CommandButton2クリック→Sheet1のB列の最終行に挿入

パターン2(TextBoxのNoがA列にある場合)
TextBox1にNoを入力→image1にTextBoxのNo=A列のNoの行にある画像を表示
CommandButton1クリック→マイピクチャフォルダ表示→image1に貼付け
CommandButton2クリック→TextBoxのNo=A列のNoの行のB列の画像を置換(元あった画像は削除)

このような処理を行いたいです。
どうかご教示よろしくお願いします。

質問者からの補足コメント

  • CommandButton2クリック→Sheet1のB列の最終行に挿入☓

    CommandButton2クリック→image1にある画像をB列の最終行に挿入○

      補足日時:2016/09/10 15:57
  • コメントありがとうございます。

    >この意味が良く分かりません。[A列のNoの行]とは?
    それとも、[A列のNoの行のB列の画像]と読むのでしょうか?
    そうです!

    パターン2については
    画像のように
    シート上にCommandButtonがあり、クリックするとUserForm表示します。
    TextBox1にNoを入力すると
    画像では、「3」を入力すると緑の画像がimage1に表示で
    画像というButtonをクリックすると、GETFolderOPENで画像を選択(例では青の画像を選択)
    したら、登録Buttonをクリックすると
    Sheetの3のNoのところの画像が青に変わるようにしたいということです。

    「UserFormからの画像挿入 Exce」の補足画像2
      補足日時:2016/09/14 09:19
  • うーん・・・

    続いてパターン1は

    Sheet上のCommandButtonをクリックするとUserForm表示
    TextBoxに「5」を入力し、画像Buttonクリックで画像選択(空の画像)
    したら登録で、A列にない数字は最終行に追加するということをしたいです。

    説明が下手で申し訳ございません・・・

    「UserFormからの画像挿入 Exce」の補足画像3
      補足日時:2016/09/14 09:29

A 回答 (6件)

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


どの部分の事でしょうか?

拡張子がPNGなら、JPGの部分を変更するだけですが、
画像が2種類となると複雑になるので、元の画像の拡張子は統一するべきだと思います。
    • good
    • 0
この回答へのお礼

間違えました。
ACWidth = shp.Width
ACHeight = shp.Height
Set TCht = ActiveSheet.ChartObjects.Add(0, 0, ACWidth, ACHeight).Chart

ACWidth、ACHeight、TChtの部分でした。すみません・・

そうですね・・・JPGとして統一することにします。

お礼日時:2016/09/20 15:16

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 & "\tmp.jpg")
Kill ThisWorkbook.Path & "\" & fname & ".jpg"
End If
End Sub
    • good
    • 0
この回答へのお礼

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

また、現在JPGとなってますが、PNGの場合はどうすればいいのでしょうか?

お礼日時:2016/09/20 14:13

#1の回答者です。


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

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

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

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

もう少し、こちらは発表までに時間が掛かりそうです。
    • good
    • 0
この回答へのお礼

コメントありがとうございます。

>少し教えていただきたいのは、その画像は、写真などですよね
基本、写真で撮った画像(jpg)ですが、たまに(png)でいれるかもしれません。

>Worksheets("Sheet1").Shapes.AddPicture

で、画像をインポートしましたが、正しい形にならず、失敗を繰り返しています。
私のためにありがとうございます・・・

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

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

No2さんがかなり手間のかかることだとおっしゃっていたので、やりたいことが実行できるならそれにこしたことはありません。

お礼日時:2016/09/16 16:44

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
    • good
    • 0

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


既に存在する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
    • good
    • 0
この回答へのお礼

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

これはやはり厳しいのですね・・・諦めます・・・
保存先から参照するやり方はあるサイトで見かけました。また必要に感じたらそれを組み込むようにしてみます。

またパターン1のような処理に関しては、
どうすればいいでしょうか?

すみません。よろしくお願いします。

お礼日時:2016/09/14 12:19

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



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

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

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

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

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

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

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

図とかないと、想像だけでは、内容が伝わっていないように思うのです。
    • good
    • 0
この回答へのお礼

コメントありがとうございます。
補足させていただきました。

お礼日時:2016/09/14 09:30

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!