Excel VBA質問箱 IV

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

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


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

【4781】画像の貼り付け soc 03/4/7(月) 10:22 質問
【4792】Re:画像の貼り付け りん 03/4/8(火) 6:35 回答
【4793】Re:画像の貼り付け こうちゃん 03/4/8(火) 8:47 発言
【4833】Re:画像の貼り付け soc 03/4/9(水) 21:26 お礼

【4781】画像の貼り付け
質問  soc  - 03/4/7(月) 10:22 -

引用なし
パスワード
   エクセルのシートに画像を選択して張りつけるにはどうしたらよいのでしょうか?

具体的に言いますと、

記録表のSheet1の
height=119.25
width=86.25
rotation=0#
increment rotation=90#
increment left 185#
increment top 90#

の位置・サイズにフォルダ「A030401」に入っている画像を選択して張りつけるという作業なのですが…。

【4792】Re:画像の貼り付け
回答  りん E-MAIL  - 03/4/8(火) 6:35 -

引用なし
パスワード
   soc さん、おはようございます。
>height=119.25
>width=86.25
>rotation=0#
>increment rotation=90#
>increment left 185#
>increment top 90#

>の位置・サイズにフォルダ「A030401」に入っている画像を選択して張りつけるという作業なのですが…。
 これは、位置というよりも、画像の情報(大きさと角度)のようですけど?

ファイル名を指定して画像を読み込む方法
その1 GetOpenFilename を使う方法
Sub tempo1()
  Dim Filt As String, Ifile As Variant
  Dim Path2
  '
  Path2 = "D:\A030401"
  If Dir(Path2, vbDirectory) <> "" Then _
   ChDrive Path2: ChDir Path2
  '
  Filt = "Bmp (*.bmp),*.bmp,Emf (*.emf),*.emf,Gif (*.gif),*.gif,Jpg (*.jpg),*.jpg"
  Ifile = Application.GetOpenFilename(Filt)
  '
  If Not Ifile = False Then
   Application.ScreenUpdating = False
   ActiveSheet.Pictures.Insert(Ifile).Select
   With Selection
     .Top = 0  '位置(A1セルの上端)
     .Left = 0 '位置(A1セルの左端)
     .Height = 119.25
     .Width = 86.25
     '.Rotation = 0#   Pictureは回転できない?
   End With
   Application.ScreenUpdating = True
  Else
   MsgBox "キャンセル", vbExclamation
  End If
  ActiveCell.Activate '図形から離れる
End Sub

その2 組み込みダイアログ(ピクチャ挿入)を使う方法
Sub tempo2()
  Path2 = "D:\A030401"
  If Dir(Path2, vbDirectory) <> "" Then _
   ChDrive Path2: ChDir Path2
  '
  ActiveCell.Activate 'TypeName(Selection) = "Range"
  Application.Dialogs(xlDialogInsertPicture).Show
  If TypeName(Selection) = "Picture" Then
   Application.ScreenUpdating = False
   With Selection
     .Top = 0
     .Left = 0
     .Height = 119.25
     .Width = 86.25
     '.Rotation = 0#   Pictureは回転できない?
   End With
   Application.ScreenUpdating = True
  Else
   MsgBox "キャンセル", vbExclamation
  End If
  ActiveCell.Activate '図形から離れる
End Sub

こんな感じです。

【4793】Re:画像の貼り付け
発言  こうちゃん E-MAIL  - 03/4/8(火) 8:47 -

引用なし
パスワード
   りんさん、socさん、こんにちは

蛇足ですが・・

>'.Rotation = 0#   Pictureは回転できない?

・・のようですね。
回転等の必要があればOLEオブジェクトとして貼り付けて、そちらで処理することにして逃げたことがあります。

ActiveSheet.Shapes.AddOLEObject Left:=185, Top:=90, _
  Width:=86.25, Height:=119.25, _
  Filename:="d:\temp\0001.jpg", link:=False

【4833】Re:画像の貼り付け
お礼  soc  - 03/4/9(水) 21:26 -

引用なし
パスワード
   ありがとうございます!

また、質問するんですけど…。

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