図形・オートシェイプを回転させたり、枠線を非表示にするなど、少し面倒なコードを書きあげてみた ー Shape & ChartObject（VBAマクロ）

          

封筒のあて名を書く時、横書きにすると、少し戸惑いを感じることがあります。

それは、封をするベロの位置を左にして書くのか、右にするのかという書き方。

縦書きの長三封筒だと、ベロのある上部に郵便番号のマス枠が印刷されている。

これを考えると、ベロを左側に置いて、宛名を横書きにするのが普通と思うな。

ところが、OA化で複合機のプリンターを使って、宛名印刷をする時は右側なの。

先ず、手差しで容紙を送るゴムローラーがベロ部からだと紙詰まりを起こすな。

しかも、このベロは、折り込んで封をする目的で、両端がカットされています。

この形状は、印刷の紙送りガイドで送られると、紙詰まりしやすいかもしれん。

だから、トラブルを防ぐためには、底部から紙送りがされるように配置するな。

すると、写真のように底部を左にして、横書きの宛名が印刷される分けなんだ。

まあ、VBAのプログラムで考えた場合、底部から印刷するのは問題ありません。

問題は、宛名がベロのある方から横書きされる場合で、プログラムで一工夫だ。

先ず、エクセルのワークシート上にテキストボックスを設けて宛名書きを入力。

このテキストボックスを180度回転させてから、画像として保存するやり方ね。

       

後は、ワード側のマクロから、画像を指定した位置に貼りつける作業をします。

まあ、印刷目的でエクセルからワードを操作する、前回の投稿が参考になるな。

次に、セルに宛名を入力した手法があり、これは少しややこしい操作をします。

回転させないで画像として保存してから、シートに改めて呼出して回転させる。

これを、改めて保存させると言う方法、これは次回の投稿に譲るとしましょう。

というわけで、図形シェイプやテキストボックスをグループにして回転します。

この方法を使えば、複合印刷機の手差しトレイからでも、封筒のベロ側から横書きになる宛名書きができるようになるので、便利だと思った方は試してみてもらいたいと思うのでした。

※マクロのコード（写真の通り、三つのテキストボックス）

Sub ObjctGrpngImgSve()  '三つのオブジェクトをグループ化で画像保存

Dim SN(0 To 2) As String, N1 As Single, N2 As Single, cht As chart

  SN(0) = ActiveSheet.Shapes(1).Name  'オブジェクト１の名前で格納

    SN(1) = ActiveSheet.Shapes(2).Name  'オブジェクト２名前で格納

      SN(2) = ActiveSheet.Shapes(3).Name  'オブジェクト２名前で格納

ActiveSheet.Shapes.Range(SN).Group.Name = "group1"

  ActiveSheet.Shapes("group1").Select

     Selection.ShapeRange.IncrementRotation 180

     　N1 = Selection.Width

     　N2 = Selection.Height

    Selection.CopyPicture appearance:=xlScreen, Format:=xlPicture

    ' Chartに画像を挿入して貼り付け

Set cht = ActiveSheet.ChartObjects.Add(0, 0, N1, N2).chart

  With cht

    .Parent.Select

      .Paste

        ActiveSheet.ChartObjects(1).chart.ChartArea.Format.Line.Visible _

          = msoFalse 'オブジェクトの外枠線消去

            .Export "C:" & Environ("HOMEPATH") & "\Downloads\" & _

              "Address.png" 'チャートを保存

  End With

    Selection.Delete

      ActiveSheet.ChartObjects(1).Delete

        ActiveSheet.Shapes.Range(Array("group1")).Select

      Selection.ShapeRange.IncrementRotation -180

    Selection.ShapeRange.Ungroup.Select '保存後の原状復帰、後処理工程

End Sub

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村