エクセルに写真を挿入するマクロを組んでいます。
2003までは問題なく動作していたマクロが、
2007では位置調整がうまく行きません。
そこでネットで検索して
With Selection
.Left = Range("C6").Left
.Top = Range("C" & rowa).Top
End With
のように Selection.Left を使えば解決するとありましたが、
(1)WIN VISTAのエクセル2007では
おなじひとつのエクセルファイルの
あるシートではコード通りが位置でるのに
違うシートでは縦位置がずれる。
(2)WIN XPのエクセル2007では
すべてのシートで縦位置がずれる。
ただし、ずれの位置は(1)よりは少ない。
といずれのOSでも不具合が出ます。
事情によりエクセル2007でこのマクロを使用しなければならなくなり
非常に困っております。
どなたか解決方法をご存知の方、よろしくお願いします。
なお、(2)のWIN XPでは、エクセル2003も入っており、
その中では、全く問題なくマクロが動作しています。
実際のコードは下の通りです。
Sub 写真呼出(koumoku, jpgf, tr As Variant)
Dim rowa As String
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = tr ←選択したセルの行ナンバー
ActiveSheet.Pictures.Insert(motopath & "写真\" & koumoku & "\" & jpgf & ".JPG").Select
Selection.Name = "写真"
Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比の固定
Selection.ShapeRange.Height = 480
'Selection.ShapeRange.IncrementLeft 100 ←不具合が出たので止めた部分
'Selection.ShapeRange.IncrementTop 40 ←不具合が出たので止めた部分
rowa = tr + 2
With Selection
.Left = Range("C6").Left
.Top = Range("C" & rowa).Top
End With
End Sub
No.4ベストアンサー
- 回答日時:
2007はPictures.Insertメソッドで位置がズレるという話があったような気がしますね。
私のwinXPsp3/xl2007sp2(12.0.6535.5002)環境で試してみましたが、
どうも再現しません。
OfficeUpdateはお済みでしょうか。
#必要なら後日Vistaでも試してみますが。
とりあえず
【お試し案1】Selectしない
Dim rowa As String
Dim fname As String
rowa = tr + 2
fname = motopath & "写真\" & koumoku & "\" & jpgf & ".JPG"
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = tr
With ActiveSheet.Pictures.Insert(fname)
.ShapeRange.LockAspectRatio = msoTrue
.Name = "写真"
.Height = 480
.Left = Range("C" & rowa).Left
.Top = Range("C" & rowa).Top
End With
【お試し案2】Zoom変更
Dim rowa As String
Dim fname As String
Dim n As Long
rowa = tr + 2
fname = motopath & "写真\" & koumoku & "\" & jpgf & ".JPG"
With ActiveWindow
n = .Zoom
.Zoom = 100
End With
ActiveSheet.Pictures.Insert(fname).Select
With Selection
.ShapeRange.LockAspectRatio = msoTrue
.Name = "写真"
.Height = 480
.Left = Range("C" & rowa).Left
.Top = Range("C" & rowa).Top
End With
With ActiveWindow
.Zoom = n
.ScrollColumn = 1
.ScrollRow = tr
End With
【お試し案3】Shapes.AddPictureメソッド
Dim rowa As String
Dim fname As String
rowa = tr + 2
fname = motopath & "写真\" & koumoku & "\" & jpgf & ".JPG"
With ActiveSheet.Shapes.AddPicture(Filename:=fname, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=Range("C" & rowa).Left, _
Top:=Range("C" & rowa).Top, _
Width:=100, _
Height:=100)
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
.LockAspectRatio = msoTrue
.Name = "写真"
.Height = 480
End With
With ActiveWindow
.ScrollColumn = 1
.ScrollRow = tr
End With
この回答への補足
end-uさん、非常に詳しいご回答ありがとうございます。
さっそく試してみたところ
お試し案1⇒横位置、縦位置ともにずれる。
(2)の結果と同じ不具合が出る。
お試し案2⇒すべてのSheetで正しい位置で表示される。
ただし、画面表示が一度大きくなってから元に戻る。
お試し案3⇒縦位置だけ少しずつずれていく。
ただし、お試し案1よりは、ずれ幅は小さい。
という結果になりました。
この結果から推察されることがありましたら
また、ご教示くださると幸いです。
今の状況ですと、お試し案2で行くことになりますが、
画面がちらつくのが少々煩わしいです。
確かこのちらつきは出させない命令があったようですが、
よく覚えていません。(汗)
end-uさん、詳しい御説明ありがとうございました。
あらためてお礼申し上げます。
なお、上記の補足の追加です。
お試し案を試したのは自宅パソコンで
WIN XP SP3で、エクセル2007SP?(12.0.4518.1014)です。
また、同じパソコンに混在しているエクセル2003で試したところ
お試し案1,3とも表示位置は正しく出ていましたが
写真の横サイズが調整されずに元のサイズのまま?長くなっていました。
(極端に横長の写真表示になっている)
お試し案2では、正常なサイズで表示されていました。
この辺りもなぜそうなるのか不明です。
No.6
- 回答日時:
ぁ、失礼。
>fname = motopath & "@myDoc\" & koumoku & "\" & jpgf & ".JPG"
こりゃ自分の環境でしたorz
fname = motopath & "写真\" & koumoku & "\" & jpgf & ".JPG"
修正してくださいね。
end-u さん、たびたびありがとうございます。
ご指摘の通り、Microsoft Updateで最新のものに
更新したところ、上記の不具合が解消されました。
質問した最初のコードで行けましたので、とりあえず
これで行きたいと思います。
本当にどうもありがとうございました。
〈補足〉
今回はMicrosoft Updateで直りましたが、
実はもう一つ不具合があります。
(jpegファイルを呼び出すのに2003までなら行けるのに
この2007では呼び出しに失敗するところがあります。←同じコードなのに)
この不具合については、また改めて質問させていただきたいと思います。
No.5
- 回答日時:
Zoomの問題のようですね。
>WIN XP SP3で、エクセル2007SP?(12.0.4518.1014)です。
OfficeUpdateで直りそうな気もしますが、以下で。
Sub 写真呼出(koumoku, jpgf, tr As Variant)
Dim rowa As String
Dim fname As String
Dim n As Long
Dim r As Range
On Error GoTo errHndlr
rowa = tr + 2
fname = motopath & "@myDoc\" & koumoku & "\" & jpgf & ".JPG"
Set r = ActiveCell
With Application
.ScreenUpdating = False
.EnableEvents = False
.Goto Range("A" & tr), True
End With
With ActiveWindow
n = .Zoom
.Zoom = 100
End With
With ActiveSheet.Pictures.Insert(fname)
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Height = 480
.Left = Range("C" & rowa).Left
.Top = Range("C" & rowa).Top
.Name = "写真"
End With
ActiveWindow.Zoom = n
r.Activate
errHndlr:
Set r = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
>お試し案1,3とも表示位置は正しく出ていましたが
>写真の横サイズが調整されずに元のサイズのまま?長くなっていました。
1,2は、ShapeRangeに対してHeight変更するのを忘れてました。すみません。
3は...再現しなかったのでわかりません。ActiveCell位置も関係ないですしね。
2ならありえますが。
上記コードはその辺りも一応考慮してます。
いずれにしても、Service Packはあてといた方が良いと思いますけども。
http://support.microsoft.com/kb/928116/ja
Microsoft Updateを利用してください。
http://update.microsoft.com/microsoftupdate/v6/d …
>#必要なら後日Vistaでも試してみますが。
ちなみにVistaでも再現しませんでした。
No.3
- 回答日時:
2007で検証が出来ないのですが、私は
Top = Range("C" & rowa).Top
のセルについて
質問者が目指すものと
コード実行の現実が違うだけで、
この程度の内容の個所は、バージョンの変更で影響を受けてないと予想します。
テストをじっくりしてみるのが先決ではないですか。
具体的にC6などセルを指定しても「ずれ」が起こりますか?その際セルのシートを明示のこと。
他にシートのセルと貼り付けた図形(オブジェクト)の位置関係をコントロールする、「図の書式設定」の「プロパティ」なども、念のためチェックを。
この回答への補足
imogasiさん、ご回答どうも有難うございます。
>この程度の内容の個所は、バージョンの変更で影響を受けてないと予想します。
私もそう思う部分もあります。
と言いますのも、このマクロを実行させた場合、
同じエクセル2007でも結果が微妙に違っているからです。
最初の質問のところで書きましたが
(1)WIN VISTA では ある特定のシート(1枚だけですが)では正常に表示され
その他のSheetではすべての表示が少しずつずれる。
(詳しく書きますと)
項目別に複数のSheetがあり、各SheetのA列にはjpegファイル名が表示されています。
jpegファイル名の入ったセルをクリックすると、例えばそのセルが(4,1)とすると
セル(6,3)の左上からそのクリックした写真を表示させています。
(列位置は3列目に固定、行位置は選択セルの2行下)
(1)の環境では、下の方のセルをクリックすればするほど縦位置のずれが大きくなる
ということです。
(2)WIN XPでは、表示位置はすべてのSheetでずれます。
ただしずれ幅は(1)の場合より少ないです。
つまり、おなじマクロでも、実行させる環境で異なる結果が出ますので、
OSやエクセルの設定が異なることからの不具合とも考えられます。
ただ
>他にシートのセルと貼り付けた図形(オブジェクト)の位置関係をコントロールする、
>「図の書式設定」の「プロパティ」なども、念のためチェックを。
など、よく分からないところもありますので、
具体的なチェックポイントを教えていただければ幸いです。
No.2
- 回答日時:
#1です
難しいです
関連するコードが分らないので無理に近いですよ
関連するすべてのコードを見ないと
どのコードが関係しているのかわかりません
>因みに
>'Cells(tr, 3).Select
>でこのコードを無効化すると何故か・・・
原因が特定できません
良い方法では有りませんが
Application.EnableEvents = False
Cells(tr, 3).Select
Application.EnableEvents = True
としたらどうなります?
アドバイスとしては
コード中のselection(select)を極力無くしてください
selectionでは何に対して処理をしているのかが分りにくい
スキルが上がってくると最後の表示くらいにしか使用しません
Worksheet_SelectionChangeなどイベントを使用する場合は
範囲を限定して他のコードに影響のないようにする
今回のように"Cells(tr, 3).Select"を実行すると
無限ループにならないよう対策をする必要があると思います
すべてのコードを見直す必要があると思いますよ
この回答への補足
hige 082さん、再度のご回答ありがとうございます。
Application.EnableEvents = False
Cells(tr, 3).Select
Application.EnableEvents = True
を試してみましたが、写真の表示⇒表示⇒表示⇒・・・
の繰り返しで修正前と同じ結果となりました。
上記のSubルーチンは、写真の表示だけに使うためのもので
今回の不具合についてはこの部分だけと考えています。
確かに、Worksheet_SelectionChangeを使うなど注意が
必要なところもありますが、
エクセル2003では正常な位置に(全てのSheetで)表示されますので、
エクセル2007特有の問題と思っているのですが。
No.1
- 回答日時:
たいした修正はしていませんが、試してみて
Sub 写真呼出(koumoku, jpgf, tr As Variant)
Dim rowa As String
Cells(tr, 3).Select
rowa = tr + 2
ActiveSheet.Pictures.Insert(motopath & "写真\" & koumoku & "\" & jpgf & ".JPG").Select
Selection.Name = "写真"
With ActiveSheet.Pictures("写真")
.LockAspectRatio = msoTrue '縦横比の固定
.Height = 480
.Left = Range("C" & rowa).Left
.Top = Range("C" & rowa).Top
End With
End Sub
excel2007を持っていないので検証できてません
参考程度に
この回答への補足
回答どうもありがとうございます。
さっそく試してみましたが、このマクロでは
Worksheet_SelectionChange
を使っており、
Cells(tr, 3).Select
の部分で誤動作(写真の表示、消去、また表示の
無限ループ)を起こします。
因みに
'Cells(tr, 3).Select
でこのコードを無効化すると何故か
With ActiveSheet.Pictures("写真")
.LockAspectRatio = msoTrue '縦横比の固定
.Height = 480
.Left = Range("C" & rowa).Left
.Top = Range("C" & rowa).Top
End With
が全く効かないです。
なお、今は(2)のWIN XPでの環境しか試せません。
また補足ですが、
.Left = Range("C6").Left はご指摘の通り
.Left = Range("C" & rowa).Left が正しいです。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- PowerPoint(パワーポイント) ExcelのVBAコードについて教えてください。 3 2022/05/25 14:32
- Excel(エクセル) Excelのマクロについて教えてください。 4 2022/05/31 14:07
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Visual Basic(VBA) データのある範囲を選択するVBAについて 2 2022/09/03 00:20
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Excel(エクセル) エクセルで同じ数字同士を自動で線で結ぶVBAを教えてください 6 2022/04/26 23:13
- Excel(エクセル) 【マクロ】スクショ印刷がうまく動かない件 5 2022/12/06 17:37
- Excel(エクセル) Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて 2 2022/11/15 16:14
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルファイルを値でのみし...
-
【Excel】マクロでページを追加...
-
Excelでマクロ実行中に画面を固...
-
エクセル連番自動印刷について
-
ブックの共有でVBAエラー
-
VBA Shapes コピーと名前
-
エクセルでマクロ登録の不具合解消
-
エクセル マクロ写真帳に一括で...
-
エクセルに写真を挿入するマ...
-
セルに入力するたびにマクロを...
-
マクロで非表示シート内にある...
-
秀丸で文字列範囲を選択したら...
-
エクセルのマクロについて教え...
-
エクセルVBAで納期管理システム...
-
VBAで行コピーして挿入
-
シート名を記入する
-
EXCEL VBA 他のアプリケーショ...
-
【ExcelVBA】マクロブックを通...
-
VBAマクロでCSV出力
-
VBAで保存しないで閉じると空の...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA Shapes コピーと名前
-
Excelでマクロ実行中に画面を固...
-
エクセルファイルを値でのみし...
-
エクセル連番自動印刷について
-
エクセル マクロ写真帳に一括で...
-
エクセルのマクロについて教え...
-
【Excel】マクロでページを追加...
-
セルに入力するたびにマクロを...
-
EXCEL VBA 他のアプリケーショ...
-
VBAで行コピーして挿入
-
エクセルVBAで納期管理システム...
-
EXCEL 行番号や列番号が選択で...
-
ブックの共有でVBAエラー
-
シート名を記入する
-
【ExcelVBA】マクロブックを通...
-
エクセル 図形の寸法を取得したい
-
VB.NETによるEXCELの行挿入
-
ExcelのVBAコードについて教え...
-
エクセルVBA MSGBOXを30秒間出...
-
エクセルに写真を挿入するマ...
おすすめ情報