[[20120504095902]]　『貼り付け画像がずれる』（四苦八苦）　ページの最後に飛ぶ

『貼り付け画像がずれる』（四苦八苦）
エクセルに10枚程度の写真を貼り付け、図形等を入れるためにマクロを四苦八苦しながら作成してみました。初心者で上手くいきません。2枚目のセルを選択すると、1枚目の画像と図形がずれていきます。ご指導願います。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim dlgAnser As Boolean, Cancel As Boolean
Dim x As Object
Dim MyWidth As Single, MyHeight As Single

  If Target.Columns.Count = 10 And Target.Rows.Count = 25 Then 
      MyWidth = Target.Width
      MyHeight = Target.Height
      dlgAnser = Application.Dialogs(xlDialogInsertPicture).Show      
      Application.ScreenUpdating = False
      For Each x In ActiveSheet.Shapes 
         With x
           If .Width * ActiveCell.MergeArea.Height / .Height <ActiveCell.MergeArea.Width Then　   
              .Height = ActiveCell.MergeArea.Height
           Else
              .Width = ActiveCell.MergeArea.Width 
           End If
              .Line.Visible = msoFalse
              .Top = .Top + ((MyHeight - .Height) / 2)  
              .Left = .Left + ((MyWidth - .Width) / 2)
        End With                    
      Next
      Application.ScreenUpdating = True
  End If
End Sub

Excel2003,2007,2010

私もShapeオブジェクトは初心者同然ですが、

例えば、MyWidthはTarget（その時点で選択されている結合セル）の幅、
x.widthはTargetとは関係ない物も含む、アクティブシートに配置された
Shapeのうちどれか、というのが「ずれ」の原因のような気はします。

ループは必要ですか？

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)

     Dim dlgAnser As Boolean, Cancel As Boolean
     Dim x As Object
     Dim MyWidth As Single, MyHeight As Single

     If Target.Columns.Count = 10 And Target.Rows.Count = 25 Then
         MyWidth = Target.Width
         MyHeight = Target.Height
         dlgAnser = Application.Dialogs(xlDialogInsertPicture).Show
         If dlgAnser Then
             Set x = Selection
       '      Application.ScreenUpdating = False
             With x
                 If .Width * ActiveCell.MergeArea.Height / .Height < ActiveCell.MergeArea.Width Then
                     .Height = ActiveCell.MergeArea.Height
                 Else
                     .Width = ActiveCell.MergeArea.Width
                 End If
                 .ShapeRange.Line.Visible = msoFalse
                 .Top = .Top + ((MyHeight - .Height) / 2)
                 .Left = .Left + ((MyWidth - .Width) / 2)
             End With
       '      Application.ScreenUpdating = True
         End If
     End If
 End Sub
　
[四苦八苦]さんのだと、.Line.Visible = msoFalse　でもそのままスルーするのに、
Selectionでオブジェクト変数に入れちゃうと　.ShapeRange.Line.Visible = msoFalse
としないと「オブジェクトはプロパティをサポートしていません」になる。

どなたかこの理屈、説明してくれないかなぁ。

(みやほりん)(-_∂)b

 互換性だと思いますよ！！　ShapeオブジェクトとShapeオブジェクトがなかった以前との・・。

 msgbox typename(x)

 を　Set　後に上記で調べるとわかると思いますよ！！

 ichinose@昨日、東京駅の変わりようにビックリ、有料トイレにはまいった

みやほりん様、四苦八苦です。
おかげさまで、望みのものに出来上がりました。
当方、初心者のおじさんで書籍は購入して頑張りましたが、上手く出来ませんでした。
ループは必要なかったのですね。

本当にありがとうございました。

 >.ShapeRange.Line.Visible = msoFalse
 .Border.LineStyle = xlNone

 Rectangleオブジェクトのこんなプロパティからもアクセスできますね！！

 ichinose

ichinoseさん、ヒントありがとうございます。
ちなみに、

For Each x In ActiveSheet.Shapes ・・・・でセットしたもの

 msgbox typename(x)　・・・Shape

Set x = Selection ・・・・でセットしたもの

 msgbox typename(x)　・・・Picture
　
という結果でした。
PictureオブジェクトがShape以前から対応しているオブジェクト、
Shapes コレクションから取得しているからShapeオブジェクトとして取得。
Selectionの場合はApplication.Dialogs(xlDialogInsertPicture)で挿入した
オブジェクトなのでPictureオブジェクトとして取得。

と理解していいのかな。
Shapesコレクションのヘルプに以下の記述がありました。

「文書のオートシェイプだけを処理したり、選択した図形だけを処理する場合など、文書の図形のサブセットを処理する場合は、処理する図形を含む ShapeRange コレクションを作成する必要があります。」

(みやほりん)(-_∂)b

 >理解していいのかな
 Selectionというプロパティが互換性を考慮した結果　だと言う事で
 記述されたような結果が得られたのだと解釈しています。

 私は、このDialogsオブジェクトについては、「卵くださいというと、ゆで卵をかえす出来の悪いオブジェクト」
 だと言っているのですが、今回も本当は、返すのは選択したパス名だけでよいのに・・・。
 これをShapeオブジェクトとして取得するか、以前のオブジェクトで取得するかは、
 プログラマの判断でよいのですから・・・・

 Selectionというプロパティで取得する図形のオブジェクトを旧オブジェクトに留めたのは、
 当時は、仕方ないですよね！！

 この互換性考慮がなければ、Excel95以前の図形関連のSelectionを使ったコードは、
 大きな修正が必要だったかもしれませんから・・・。

 もっとも、互換性をとるか、新しい技術で要らないものは捨てるか
 難しい判断ですけどね！！

 ichinose

 >Rectangleオブジェクトのこんなプロパティ
 これは、私のテストデータでの話でした。失礼しました。

 但し、Pictureでも　Borderは使えます。

 念のために・・・。

 ichinose

四苦八苦です。
みやほりん様とichinose様に教授して頂いて完成したマクロを使用しています。私の環境はエクセル2007で、正常に作動しています。一つだけあるとしたら、挿入時のApplication.ScreenUpdating = Falseが効果がないみたいですが、悪いコードのためでしょうか？　又、エクセル2003の友人に進めたら、写真のアスペクト比の維持ができないと言っていました。私は環境が違うのでわかりませんが、そうなんでしょうか？

私の提示したマクロは「'」を付けてステートメントをコメント化しています。
つまり、Application.ScreenUpdating = Falseをあえて無効化していますが、
この点はご了解いただいていますか？
デバッグが十分でないうちに画面更新を無効化はしないほうが良いという主義です。

＞写真のアスペクト比の維持ができないと言っていました。
幅、または高さを調節するロジックなので、そうなるのかもしれません。
最初に貼り付けた時点での縦横比を求めておいて、
幅（高さ）が調節されたあと、縦横比から高さ（幅）を調節するという処理を
加えても良いかもしれません。
（みやほりん）

理屈はわかりませんが、2003でも縦横比が維持されました（マナ）

 ２行修正

 Set x = Selection.ShapeRange

 .Line.Visible = msoFalse

四苦八苦です。早速の回答ありがとうございました。
「'」での無効化は理解しています。
友人の2003は私の環境と違いますので、解りません。
２行修正して頂いてありがとうございました。

コメント返信：

[ 一覧(最新更新順) ]

[[20120504095902]] 『貼り付け画像がずれる』（四苦八苦） ページの最後に飛ぶ

[[20120504095902]]　『貼り付け画像がずれる』（四苦八苦）　ページの最後に飛ぶ