Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11031 / 13644 ツリー ←次へ | 前へ→

【18486】イメージ図をエクセルに・・・ 初心者 04/9/28(火) 12:13 質問[未読]
【18489】Re:イメージ図をエクセルに・・・ IROC 04/9/28(火) 12:55 回答[未読]
【18492】Re:イメージ図をエクセルに・・・ 初心者 04/9/28(火) 14:07 回答[未読]
【18493】Re:イメージ図をエクセルに・・・ IROC 04/9/28(火) 14:16 回答[未読]
【18494】Re:イメージ図をエクセルに・・・ 初心者 04/9/28(火) 14:37 回答[未読]
【18496】Re:イメージ図をエクセルに・・・ IROC 04/9/28(火) 14:48 回答[未読]
【18498】Re:イメージ図をエクセルに・・・ 初心者 04/9/28(火) 14:54 回答[未読]
【18505】Re:イメージ図をエクセルに・・・ IROC 04/9/28(火) 16:03 回答[未読]
【18531】Re:イメージ図をエクセルに・・・ ichinose 04/9/28(火) 23:31 発言[未読]
【18541】Re:イメージ図をエクセルに・・・ 初心者 04/9/29(水) 9:15 質問[未読]
【18547】Re:イメージ図をエクセルに・・・ ichinose 04/9/29(水) 12:55 発言[未読]
【18550】Re:イメージ図をエクセルに・・・訂正 ichinose 04/9/29(水) 13:09 発言[未読]
【18554】Re:イメージ図をエクセルに・・・訂正 初心者 04/9/29(水) 14:52 お礼[未読]

【18486】イメージ図をエクセルに・・・
質問  初心者  - 04/9/28(火) 12:13 -

引用なし
パスワード
   はじめまして。

フォーム上にあるイメージ図をエクセルに書き出したいのですがどうしたら良いですか??
誰か教えてくださいm(__)m

【18489】Re:イメージ図をエクセルに・・・
回答  IROC  - 04/9/28(火) 12:55 -

引用なし
パスワード
   「フォーム上にあるイメージ図」
「エクセルに書き出したい」

これらは何のことでしょうか?

【18492】Re:イメージ図をエクセルに・・・
回答  初心者  - 04/9/28(火) 14:07 -

引用なし
パスワード
   ▼IROC さん:
>「フォーム上にあるイメージ図」
>「エクセルに書き出したい」
>
>これらは何のことでしょうか?
UserFormにあるImageのPictureを書き出したんですよ。

If OptionButton1.Value = True Then
Worksheets("Sheet1").Cells(10, 10).Value = Image1.Picture
ElseIf OptionButton2.Value = True Then
Worksheets("Sheet1").Cells(10, 10).Value = Image1.Picture
End If

のような感じで書きたいのですがどうしたらよいですか?
始めたばかりでどう書けばいいのかもわからずにうまく伝わらないかもしれません><

【18493】Re:イメージ図をエクセルに・・・
回答  IROC  - 04/9/28(火) 14:16 -

引用なし
パスワード
   Image1.Picture の画像のパスはどのように指定していますか?


パスが分かっているのであれば、
画像の挿入を使っては如何でしょうか?

dim myPath as String
  myPath = "C:\sample.jpg"
  ActiveSheet.Pictures.Insert(myPath).Select

【18494】Re:イメージ図をエクセルに・・・
回答  初心者  - 04/9/28(火) 14:37 -

引用なし
パスワード
   ▼IROC さん:
>Image1.Picture の画像のパスはどのように指定していますか?
保存した図ではなくて、別の場所でかいた図を貼り付けました。

>
>
>パスが分かっているのであれば、
>画像の挿入を使っては如何でしょうか?
>
>dim myPath as String
>  myPath = "C:\sample.jpg"
>  ActiveSheet.Pictures.Insert(myPath).Select

しかもImageの上にラベルも載せているんですが、まとめて書き出すことは無理でしょうか??

【18496】Re:イメージ図をエクセルに・・・
回答  IROC  - 04/9/28(火) 14:48 -

引用なし
パスワード
   >保存した図ではなくて、別の場所でかいた図を貼り付けました。
どのように行ったのか、操作手順を教えて下さい。


>しかもImageの上にラベルも載せているんですが、
>まとめて書き出すことは無理でしょうか??
ユーザーフォームのある一部分を画像として、
シート上に表示したいということでしょうか?

【18498】Re:イメージ図をエクセルに・・・
回答  初心者  - 04/9/28(火) 14:54 -

引用なし
パスワード
   ▼IROC さん:
>>保存した図ではなくて、別の場所でかいた図を貼り付けました。
>どのように行ったのか、操作手順を教えて下さい。

エクセルで書いた図形をコピーし、Image1のプロパティのPictureの項目に貼り付けました。
すると(メタファイル)と記されましたが・・・

>
>>しかもImageの上にラベルも載せているんですが、
>>まとめて書き出すことは無理でしょうか??
>ユーザーフォームのある一部分を画像として、
>シート上に表示したいということでしょうか?
その通りです!!

【18505】Re:イメージ図をエクセルに・・・
回答  IROC  - 04/9/28(火) 16:03 -

引用なし
パスワード
   かなり難しいです。
どのようにして良いのか、まったく思いつかないです。

識者の回答をお待ち下さい。

【18531】Re:イメージ図をエクセルに・・・
発言  ichinose  - 04/9/28(火) 23:31 -

引用なし
パスワード
   初心者さん、IROC さん、こんばんは。
ユーザーフォーム(Userform1)にイメージコントロール(Image1)とコマンドボタン
(Commandbutton1)があると想定しましょう。

まず、コピー&ペーストで画像が表示されているユーザーフォーム上のImageコントロールのみの処理ならば、
例えば、コマンドボタンのクリックイベントで、
'==========================================================
Private Sub CommandButton1_Click()
  Call SavePicture(Image1.Picture, ThisWorkbook.Path & "\temp.gif")
  ActiveSheet.Pictures.Insert ThisWorkbook.Path & "\temp.gif"
End Sub

なんてコードでイメージコントロールの内容をシートに表示する事は可能です
(このコードのあるマクロは一度保存してから実行して下さい。Thisworkbook.Path
を使用しているため・・)。
イメージコントロールの上にラベルが貼り付けてあるのならそれだけ新たにシート上に
作成しても良いかと思います(それの方が簡単だから)。


他の方法としては、ユーザーフォームに対してハードコピーをとって、シートに貼り付けた後、トリミングするという方法。
但し、ラベルは、イメージコントロールの中にあるという想定です。

Print Screenって、Sendkeysではできないんでしょうか?
仕方ないんで調べました。
APIの細かいところは、

http://support.microsoft.com/default.aspx?scid=kb;en-us;240653

↑を参考にしました(というより、ほぼコピー)。

最初と同様に

ユーザーフォーム(Userform1)にイメージコントロール(Image1)とその中に収まるようなラベル(Label1)とコマンドボタン(Commandbutton1)があると想定しましょう。
標準モジュールに

'================================================================
Option Explicit

Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Declare Function GetVersionExA Lib "kernel32" _
   (lpVersionInformation As OSVERSIONINFO) As Integer

Public Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_SNAPSHOT = &H2C
Public Const VK_MENU = &H12
'============================================================
Sub main()
  UserForm1.Show
End Sub


'Userform1のモジュールには、

'=============================================================
Dim blnAboveVer4 As Boolean
'=============================================================
Private Sub CommandButton1_Click()
  Dim shp As Shape
  If blnAboveVer4 Then
   keybd_event VK_SNAPSHOT, 1, 0, 0
  Else
   keybd_event VK_MENU, 0, 0, 0
   keybd_event VK_SNAPSHOT, 0, 0, 0
   keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
   keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
   End If
  DoEvents
  ActiveSheet.Select
  Range("a1").Select
  ActiveSheet.Paste
  Call Trimming
End Sub
'=================================================================
Private Sub UserForm_Initialize()
  Dim osinfo As OSVERSIONINFO
  Dim retvalue As Integer
  osinfo.dwOSVersionInfoSize = 148
  osinfo.szCSDVersion = Space$(128)
  retvalue = GetVersionExA(osinfo)
  If osinfo.dwMajorVersion > 4 Then blnAboveVer4 = True
End Sub
'===================================================================
Sub Trimming()
  With ActiveSheet
   Set shp = .Shapes(.Shapes.Count)
   With shp.PictureFormat
     .CropTop = Image1.Top + 15.75
     .CropLeft = Image1.Left
     .CropRight = Me.Width - Image1.Left - Image1.Width
     .CropBottom = Me.Height - Image1.Top - Image1.Height - 15.75
     End With
   End With
End Sub


mainを実行して、コマンドボタンをクリックしてみてください。
(イメージコントロールのPictureには予め画像データをセットして置いてください)

確認してみて下さい。

【18541】Re:イメージ図をエクセルに・・・
質問  初心者  - 04/9/29(水) 9:15 -

引用なし
パスワード
   ▼ichinose さん:
ichinose さん、ありがとうございます。
>'==========================================================
>Private Sub CommandButton1_Click()
>  Call SavePicture(Image1.Picture, ThisWorkbook.Path & "\temp.gif")
>  ActiveSheet.Pictures.Insert ThisWorkbook.Path & "\temp.gif"
>End Sub
>なんてコードでイメージコントロールの内容をシートに表示する事は可能です
表示が出来ました!!

>イメージコントロールの上にラベルが貼り付けてあるのならそれだけ新たにシート上に
>作成しても良いかと思います(それの方が簡単だから)。

ラベルを貼り付ける場合の型はどのようにしたら良いですか??

【18547】Re:イメージ図をエクセルに・・・
発言  ichinose  - 04/9/29(水) 12:55 -

引用なし
パスワード
   ▼初心者 さん:
こんにちは。

>ichinose さん、ありがとうございます。
>>'==========================================================
>>Private Sub CommandButton1_Click()
>>  Call SavePicture(Image1.Picture, ThisWorkbook.Path & "\temp.gif")
>>  ActiveSheet.Pictures.Insert ThisWorkbook.Path & "\temp.gif"
>>End Sub
>>なんてコードでイメージコントロールの内容をシートに表示する事は可能です
>表示が出来ました!!
こっちでやるのですね!!

>>イメージコントロールの上にラベルが貼り付けてあるのならそれだけ新たにシート上に
>>作成しても良いかと思います(それの方が簡単だから)。
>
>ラベルを貼り付ける場合の型はどのようにしたら良いですか??
コントロールツールボックスのラベルが動的に作成できれば良いのですが、
作成すると色々と問題があるようです。
よって、Shapeのテキストボックスで代用しました。
テキストボックスは、図形のすぐ下に作成するようなコードにしましたが、
問題があるなら位置の変更を行って下さい。

以下のコードは、
「ユーザーフォーム(Userform1)にイメージコントロール(Image1)とその中に収まるようなラベル(Label1)とコマンドボタン(Commandbutton1)がある」と想定しています。

コマンドボタンのクリックイベントで、
'===========================================================
Private Sub CommandButton1_Click()
  Dim pic As Picture
  Dim txt As TextBox
  Call SavePicture(Image1.Picture, ThisWorkbook.Path & "\temp.gif")
  Set pic = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\temp.gif")
  Set txt = ActiveSheet.TextBoxes.Add(pic.Left + 6, pic.Top + pic.Height, Label1.Width, Label1.Height)
  With Label1
   txt.Text = Label1.Caption
   txt.Font.Name = .Font.Name
   txt.Font.Size = .Font.Size
   txt.ShapeRange.Fill.ForeColor.RGB = .BackColor
   ActiveSheet.Shapes.Range(Array(pic.Name, txt.Name)).Group
   End With
  Set pic = Nothing
  Set txt = Nothing
End Sub

尚、Label1のBackcolorプロパティには、色が設定されている事を想定しています。
こんな方法でどうでしょうか?

【18550】Re:イメージ図をエクセルに・・・訂正
発言  ichinose  - 04/9/29(水) 13:09 -

引用なし
パスワード
   >'===========================================================
>Private Sub CommandButton1_Click()
>  Dim pic As Picture
>  Dim txt As TextBox
>  Call SavePicture(Image1.Picture, ThisWorkbook.Path & "\temp.gif")
>  Set pic = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\temp.gif")
>  Set txt = ActiveSheet.TextBoxes.Add(pic.Left + 6, pic.Top + pic.Height, Label1.Width, Label1.Height)
>  With Label1
>   txt.Text = Label1.Caption
>   txt.Font.Name = .Font.Name
>   txt.Font.Size = .Font.Size
>   txt.ShapeRange.Fill.ForeColor.RGB = .BackColor
>   ActiveSheet.Shapes.Range(Array(pic.Name, txt.Name)).Group
>   End With
  On Error Resume Next
  Kill ThisWorkbook.Path & "\temp.gif"
  On Error GoTo 0
>  Set pic = Nothing
>  Set txt = Nothing
>End Sub

訂正して下さい。要らないファイルは消しておかないと・・・。

【18554】Re:イメージ図をエクセルに・・・訂正
お礼  初心者  - 04/9/29(水) 14:52 -

引用なし
パスワード
   ▼ichinose さん:
>訂正して下さい。要らないファイルは消しておかないと・・・。
ありがとうございます。
ファイルが残ってて困ってたんですよ!!
またわからないことが合ったらよろしくお願いしますm(__)m

11031 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free