Excel２００３で動いたVisualが２００７では？

質問

Excel２００３で作った下記のVisual　Basicが２００７では、最初にクリックしたところには行かず
いつも同じ位置に挿入されます。
出来ればセルF1の位置に挿入したいのですが

Sub macro1()
Dim Fname As String
Dim FLT As String
Dim Sheetmei As String

FLT = "JPEGファイル(*.jpg),*.jpg"
Fname = Application.GetOpenFilename(FLT, 2, "開く", True)
If Fname = "False" Then
Exit Sub
End If

Sheetmei = Worksheets(1).Name
ActiveSheet.Pictures.Insert(Fname).Select
Call Jpeg_size_adjust

End Sub

サブで下記も有ります
Sub Jpeg_size_adjust()
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 270.75
Selection.ShapeRange.Width = 360

回答No.9

Wendy02

#8の続きです。

#2のコードを、一応、Excel 2007 で試してみました。
エラーなどでませんね。

どこでエラーを出したか知りませんが、HeightとWidth を指定してしまうのには、疑問がありますが、必要なら、サイズ指定を以下のようにすればよいと思います。

With objPic
　　　　.Top = tp
　　　　.Left = lf
　　　　.ShapeRange.LockAspectRatio = msoFalse
　　　　.ShapeRange.Height = 270.75
　　　　.ShapeRange.Width = 360
End With

もう一度、よく調べていただきたいですね。おそらく、コードの貼り付けとか、モジュールの違いやシートの問題あたりではないかと思います。基本的なレベルをクリアしていない場合のサポートには限界があります。なお、重ねて画像を張り付けるのが問題なら、その前に削除すればよいと思います。また、2007の場合は、単に、ファイルを保管するときに、ファイル自身がZIP圧縮になるだけです。

回答No.8

Wendy02

こんばんは。

たぶん、Selection でマクロが通るからというのは、他の方には申し訳ない言い方ですが、一応、VBAプログラムを常時書いている者としては、それは書けないですね。Wordとは違いますから。（^^;

ただ、Selection で通るとなると、そのオブジェクト自体が違っているという意味だから、基本的な部分が変わったということになります。エラーの種類を教えていただき、その経緯をみてみなければわかりません。ただ、ローカル・モジュールで実行したら、エラーは出るかと思います。

いずれにしても、手元に2007がありませんから、もう一度、Excel 2007 で調べてみますが、ご質問の内容が、何か揺れているような気がしますが。もし、こちらの話が必要でなければ、チェックはしますが、ここまでにしておこうと思います。

なお、Excel等に画像を貼り付けると、特殊なメタファイルに変わるはずです。

回答No.7

xls88

Web検索でヒットしました。
参考になるかも知れません。
オートシェイプに貼り付けた図の圧縮
http://www.moug.net/faq/viewtopic.php?t=33783

画像圧縮の知識がないのでよく分かりませんが、
JPEGファイルはすでに圧縮された状態なので、新規圧縮してもそれほど効果がない。
というような記事を読んだ覚えがあります。

お礼

出張先なもので
返事が遅くなりすみませんでした。
早速参考にします

回答No.6

xls88

uotaさんのオリジナルコードで
Sheetmei = Worksheets(1).Name
として、左端のシート名を変数に代入しているのですが、その後使われている形跡がないです。
もし、そのシートに写真を挿入するのなら下記のような感じにすればよいです。

Sub macro1()
　　Dim Fname As String
　　Dim FLT As String
　　Dim Sheetmei As String

　　FLT = "JPEGファイル(*.jpg),*.jpg"
　　Fname = Application.GetOpenFileName(FLT, 2, "開く", True)
　　If Fname = "False" Then
　　　　Exit Sub
　　End If

　　Sheetmei = Worksheets(1).Name
　　With ActiveSheet.Pictures.Insert(Fname)
　　　　.Left = Worksheets(Sheetmei).Range("F1").Left　'(1)
　　　　.Top = Worksheets(Sheetmei).Range("F1").Top　　'(2)
　　　　.ShapeRange.LockAspectRatio = msoFalse
　　　　.ShapeRange.Height = 270.75
　　　　.ShapeRange.Width = 360
　　End With
End Sub

あるいは、挿入部分を
　　'Sheetmei = Worksheets(1).Name　'不要
　　With ActiveSheet.Pictures.Insert(Fname)
　　　　.Left = Worksheets(1).Range("F1").Left
　　　　.Top = Worksheets(1).Range("F1").Top
　　　　.ShapeRange.LockAspectRatio = msoFalse
　　　　.ShapeRange.Height = 270.75
　　　　.ShapeRange.Width = 360
　　End With
というように直接シート名を指定しても良いかなと思います。

毎回、同じところに挿入するなら、既に挿入されている写真と重なってしまいます。
多分、Sheetmei = Worksheets(1).Nameは、違うシートに変わっているのでしょうね？

お礼

ありがとうございます。実は使っていなかったです。
消しても問題ないみたいでした。
Sheetmei = Worksheets(1).Name

マクロにも図の圧縮って有るんですか？
調べてもこれっと言うのが見つからなくって。

回答No.5

xls88

ActiveCellを指定セルに置き換えれば良いですよ。
（それぐらいのことは調べて理解しなさい！、という「天の声」が聞こえてきそうです。）

With ActiveSheet.Pictures.Insert(Fname)
　　.Left = Range("F1").Left
　　.Top = Range("F1").Top
　　.ShapeRange.LockAspectRatio = msoFalse
　　.ShapeRange.Height = 270.75
　　.ShapeRange.Width = 360
End With

他の御二方の回答も、ちょっと調べれば問題なく動くのが解ると思います。
ANo.2 Wendy02さんのコードは
Set sh = Worksheets(1)
として、写真を挿入するシートが指定されています。
Worksheets(1)とは、Excelの画面で、シート見出しが左端に表示されるシートのことです。
写真が挿入されていると思いますよ。確認してください。

ANo.4 imogasiさんの回答されたコードは
下記の右辺で、Rangeプロパティの書き方をちょっとイタズラされています。
そこを正しく直してください。
Selection.ShapeRange.Top = Range'"F1").Top
Selection.ShapeRange.Left = Range'"F1").Left

もっと詳しい解説は、それぞれのコードの意味を調べられて解らないところを補足欄で質問してください。
御二方から親切に教えて頂けると思いますよ。

Wendy02さん、imogasiさん、差し出がましくて済みません。御容赦のほど、お願いします。

お礼

すみません回答をもらう前に以前調べたので作ってみました。

With ActiveSheet.Pictures.Insert(Fname)
.Left = ActiveSheet.Range("F1").Left
.Top = ActiveSheet.Range("F1").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 270.75
.ShapeRange.Width = 360
End With

いろいろありがとうございます

回答No.4

imogasi

画像を挿入して、思うとことに移動する。
Sub Jpeg_size_adjust()
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 270.75
Selection.ShapeRange.Width = 360
Selection.ShapeRange.Top = Range'"F1").Top
Selection.ShapeRange.Left = Range'"F1").Left
End Sub
と２行追加する。
２００３だってこの２行がなければ画像の左上隅がF1セルの位置に行かないはずだ。
質問者が言うことが信じられない。

回答No.3

xls88

参考までに、Selectしないコードの一例です。

With ActiveSheet.Pictures.Insert(Fname)
　　.Left = ActiveCell.Left
　　.Top = ActiveCell.Top
　　.ShapeRange.LockAspectRatio = msoFalse
　　.ShapeRange.Height = 270.75
　　.ShapeRange.Width = 360
End With

お礼

ありがとうございます
他の方のもためしてみましたが、エラーで動きませんでした。
ｘｌｓ８８さんのは動いたのですが、指定したセルに挿入したい場合はどの様にすれば一番良いですか？
実はこのVisualは、以前別な人が作った物でいまいち分からない私が引き継いでいます。

回答No.2

Wendy02

こんにちは。

2007では試していないけれども、こんなスタイルになるのかな？

Sub macro2()
　　Dim Fname As String
　　Dim FLT As String
　　Dim sh As Worksheet
　　Dim objPic As Object
　　Dim tp As Double
　　Dim lf As Double

　　Set sh = Worksheets(1)

　　FLT = "JPEGファイル(*.jpg),*.jpg"
　　Fname = Application.GetOpenFilename(FLT, 2, "開く", True)
　　If Fname = "False" Then
　　　　Exit Sub
　　End If
　　Set objPic = sh.Pictures.Insert(Fname)
　　'位置決め
　　tp = sh.Range("F1").Top
　　lf = sh.Range("F1").Left

　　With objPic
　　　　.Top = tp
　　　　.Left = lf
　　End With
　　Set objPic = Nothing
　　Set sh = Nothing
End Sub

回答No.1

xls88

Insert後に移動すればどうでしょうか。

With Selection
　　.Left = Activecell.Left
　　.Top = Activecell.Top
End With