[[20121022153808]]　『マクロで図のコピー貼り付けとサイズ指定』（なっちゃん）　ページの最後に飛ぶ

『マクロで図のコピー貼り付けとサイズ指定』（なっちゃん）　@2007

下記のような作業を自動化するにはどのようなマクロが要りますか？
検索して頑張ってみたんですが、知識が足りずに対応できませんでした。
それくらい何とかしろよと思われても仕方ないですが、どうぞお知恵をお貸し頂けないでしょうか。

途中までは手作業でやります。
・ファイル名を"原本"というものにしています。
・シート名を、sheet1を"拡大"、sheet2を"縮小"と名前を変更しています。

・シート"拡大"にペイントでトリミングした図を貼り付け。
・図はそれ一つです。（印刷範囲外にフォームボタンを作りたいですが）
・サイズ高さを15センチに設定（横は比で自動）
・印刷で図がA4横でだいたい真ん中になるように位置調整。

・D45に図の名前を入力。

これ以降自動化したいです。
希望として、印刷されない範囲でボタンを作り、そのボタンを押すと、最後の工程まで完了したいです。

（↓↓↓ここから自動化したいです）

・シート"拡大"にある図を、シート"縮小"に貼り付け
・サイズを高さ７センチに設定（横は比で自動か、11センチ）
・A4横で印刷時だいたい真ん中になるように位置調整（セル位置で言うとF15）
・"拡大"と"縮小"のシートを印刷出力
・名前付けて保存で、「D45に入力した値○（全角スペース）図面」のファイル名で、原本と同じフォルダに保存
（例：D45に大阪府と入力するとファイル名は　「大阪府　図面」となる）

↑↑↑

そんなに複雑な作業はないんですが、自分でやろうと思うと、図の名前（picture??)が一定でなかったり、
全てのshapeでコピーとすると、フォームのボタンも一緒にコピーされたりと上手くいかなかったので、困っています。

 拡大シートには図が１つだけあるとして。
 上で説明していることはほとんどページ設定であったりマクロ記録であったり、そういもので対応可能だと思う。
 なので、

 >自分でやろうと思うと、図の名前（picture??)が一定でなかったり、 
 >全てのshapeでコピーとすると、フォームのボタンも一緒にコピーされたりと

 と、こまっているところだけ。
 拡大シートの図を縮小シートのF5に貼り付け。

 Sub Sample()
    Dim sp As Shape

    For Each sp In Sheets("拡大").Shapes
        If TypeName(sp.DrawingObject) = "Picture" Then
            sp.Copy
            With Sheets("縮小")
                .Select
                .Range("F15").Select
                .Paste
                Exit For
            End With
        End If
    Next

 End Sub

 (ぶらっと)

Sub Sample()

    Dim sp As Shape

    For Each sp In Sheets("拡大").Shapes
        If TypeName(sp.DrawingObject) = "Picture" Then
            sp.Copy
            With Sheets("縮小")
                .Select
                .Range("F5").Select
                .Paste
                Exit For
            End With
        End If
    Next
 With ActiveSheet.Shapes(1)
          .LockAspectRatio = True   '---(1)図形の縦横の比率を固定
          .Height = 300#            '---(2)高さを100ポイントに設定
          .Width = 300#             '---(3)幅を100ポイントに設定
      End With

 End Sub

↑まで作ったんですが、D45の図の名前を取得して、ファイル名として保存するには、
どのようにしたらいいのでしょうか？
やってみたんですが、変数をよくわかってないようで・・・

（なっちゃん）

 オリジナルはそのまま画面に出しておいて裏でコピーを作るのか、オリジナルの変更結果をそのまま別名で保存するのか
 そのあたりの要件がわからないけど、後者であれば、出来上がったブックを名前を付けて保存。これをマクロ記録して
 生成されるコードのパス名やブック名を動的に取得した変数にかえればいいんだけど。

 それと、与えるポイント値のベースをセンチメートルにしたい場合、自分で換算しなくても
 CentimetersToPoints メソッド という便利なものがある。
 また（おそらく）図の縦横比率はデフォルトが固定だったように思う。

 といったことも加味して以下は参考。

 Sub Sample()
    Dim sp As Shape
    Dim flag As Boolean

    For Each sp In Sheets("拡大").Shapes
        If TypeName(sp.DrawingObject) = "Picture" Then
            sp.Copy
            With Sheets("縮小")
                .Select
                .Range("F15").Select
                .Paste
                DoEvents    '保険
                With .Shapes(.Shapes.Count)
                    .Height = Application.CentimetersToPoints(7)
                End With
                flag = True
                Exit For
            End With
        End If
    Next

    If flag Then
        Sheets(Array("縮小", "拡大")).PrintOut
        ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Sheets("拡大").Range("D45").Value & "　図面.xlsm"
    Else
        MsgBox "処理すべき図がありませんでした"

    End If
 End Sub

ありがとうございます。

完璧です。おまけまですごいですね～。

面倒くさくなかったらでいいんですが、
後学の為に教えて頂きたいです。

ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Sheets("拡大").Range("D45").Value & "　図面.xlsm"

ファイルの保存は
SaveAs は　filename を引数で指定すると思っていたので、
SaveAs filename:="任意のパス\ファイル名.xls"になると思っていたのですが、

上のような記述もあるんですか？

（なっちゃん）

 ヘルプなんかでメソッドや関数を参照すると、たとえば　Workbook.SaveAs では

 式.SaveAs(FileName, FileFormat, Password, WriteResPassword, ReadOnlyRecommended, CreateBackup, AccessMode, ConflictResolution, AddToMru, TextCodepage, TextVisualLayout, Local)

 こんなふうに書かれているね。

 で、これらパラメータを上記の順番通りに
 SaveAs(○○○,□□□,△△△,・・・・) と記述する方法が【定位置指定方式】
 これは、どれが何番目だったかを覚えておかないといけないので面倒だね。

 そういったとき、規定された順番は無視して、FileName:=○○○,Password:=△△△,FileFormat:=□□□,・・・)
 こういったように、必要なものを、好きな順序で記述できるのが、キーワード指定方式。
 このほうが便利だよね。

 (途中まで定位置指定で、あるところ以降を必要なものだけのキーワード指定というのもできる）

 ただ、本件要件の　SaveAs　は、必須パラメータは最初のFileName だけなので、FileName:= と書くのも面倒（？）ということで
 定位置指定方式で書いた。

 (ぶらっと)

なるほど～。
定位置指定方式を理解していませんでした。

しょうもない事にも誠実な回答ありがとうございました。
勉強不足で申し訳ございません。

（なっちゃん）

コメント返信：

[ 一覧(最新更新順) ]

[[20121022153808]] 『マクロで図のコピー貼り付けとサイズ指定』（なっちゃん） ページの最後に飛ぶ

[[20121022153808]]　『マクロで図のコピー貼り付けとサイズ指定』（なっちゃん）　ページの最後に飛ぶ