none
環境によって画像サイズが異なる RRS feed

  • 質問

  • お世話になっております。

    複数画像をExcelに取込むマクロで環境によってサイズが異なります。
    私の環境ではピッチリと指定範囲におさまっているのが、他の環境
    では小さくなっています。

    環境:
     私: Windows10:Excel2010
        DPI:96

     他: Windows10:Excel2010
        DPI:144

    サイズ指定コード:

    TargetSize.Height = Application.CentimetersToPoints(NormalImageHeight)
    TargetSize.Width = Application.CentimetersToPoints(A4Width)

    貼り付ける画像のサイズを指定しています。
    これは、どのような環境下でも実サイズ指定をしているのでその範囲に
    おさまると思っています。

    画像取り込みコード:

    Set Image = ActiveSheet.Shapes.AddPicture(Filename:=Path, LinkToFile:=False, SaveWithDocument:=True, _
                    Left:=Rng.Left, Top:=Rng.Top, Width:=BaseSize.Width, Height:=BaseSize.Height)
    元の画像サイズで取込んで、上記のサイズに直しています。


    なぜ、環境によって大きさが変わるのでしょうか?
    cmもpointも同じく長さ指定であり、環境差(DPI)に依らないと考えています。

    2019年4月8日 2:18

すべての返信

  • コーベルさん、こんばんは。

    原因についての回答になってはいないのですが、次のURLのMicrosoftコミュニティでのやり取りと同じ現象であって、.CentimetersToPoints()の問題ではないような気がしますが、どうでしょうか。ただし.CentimetersToPoints()が目的通りに使えない状況に変わりはなく、困ったものです。回避対策を見つけたいものです。ご参考まで。

    https://answers.microsoft.com/ja-jp/msoffice/forum/msoffice_excel-mso_win10-mso_2013_release/%E9%81%95%E3%81%86pc%E3%81%A7%E4%BD%9C%E3%81%A3/19413aed-a9d2-4b7d-8c2e-63a1856ae317


    2019年6月5日 10:35
  • コーベルさん、こんにちは。

    先の返信で、「.CentimetersToPoints()の問題ではないような気がします」と書きましたが、別途、.CentimetersToPoints()に問題がないわけではないので、念のため付記します。

    もう2年くらい前に、.CentimetersToPoints()を使って図形を描画するソフトを作成しようとしたのですが、エクセルの場合は、描画されるサイズがデタラメで、断念いたしました。もともとの出自が表計算ソフトだから、仕方がないのかと思っています。症状としては、ブックの表示が標準の場合と改ページプレビューの場合とがデタラメながら同じサイズで描画され、ページレイアウトビューで描画するとデタラメ程度がマシなレベルで描画されました。このように、ブックの表示モードによっても描画が異なる点に留意が必要です。

    ちなみに、同じ図形をほぼ同じスクリプトでワードVBAでワードドキュメントに描画する場合は、ドンピシャで描画できました。

    以下にサンプルコードとして掲示しておきます。用紙の左辺から4cm上辺から5cmの位置に左上角が位置する横幅8cm縦高さ6cmの長方形を描画するものです。

    【Excel VBA】
    Sub drawBox()
    Dim xPos As Single       '図形の左上角の用紙左辺からの距離;cm>point
    Dim yPos As Single       '図形の左上角の用紙上辺からの距離;cm>point
    Dim boxWidth As Single   '図形の横幅;mm>point
    Dim boxHeigt As Single   '図形の縦高さ;mm>point
    Dim myShape As Excel.Shape
      xPos = Application.CentimetersToPoints(CSng(4))
      yPos = Application.CentimetersToPoints(CSng(5))
      boxWidth = Application.CentimetersToPoints(CSng(8))
      boxHeigt = Application.CentimetersToPoints(CSng(6))
      '図形を描画する
      With ActiveSheet
        Set myShape = .Shapes.AddShape(msoShapeRectangle, xPos, yPos, boxWidth, boxHeigt)
        '図形の線のスタイル
        myShape.Line.DashStyle = msoLineSolid
        '図形の線種
        myShape.Line.Style = msoLineSingle
        '図形の線の太さ
        myShape.Line.Weight = 1.5
        '図形の線の色
        myShape.Line.ForeColor.RGB = RGB(0, 0, 0)
        '図形の線の透明度;0.0(不透明)~1.0(透明)
        myShape.Line.Transparency = 0
        '図形の線の表示
        myShape.Line.Visible = msoTrue
        '図形の塗り潰し
        myShape.Fill.Visible = msoFalse
        '図形の塗り潰し色
        myShape.Fill.ForeColor.RGB = RGB(255, 255, 255)
        '図形の透明度;0.0(不透明)~1.0(透明)
        myShape.Fill.Transparency = 1
      End With
    End Sub

    【Word VBA】
    Sub drawBox()
    Dim xPos As Single       '図形の左上角の用紙左辺からの距離;cm>point
    Dim yPos As Single       '図形の左上角の用紙上辺からの距離;cm>point
    Dim boxWidth As Single   '図形の横幅;mm>point
    Dim boxHeigt As Single   '図形の縦高さ;mm>point
    Dim myShape As Word.Shape
      xPos = Application.CentimetersToPoints(CSng(4))
      yPos = Application.CentimetersToPoints(CSng(5))
      boxWidth = Application.CentimetersToPoints(CSng(8))
      boxHeigt = Application.CentimetersToPoints(CSng(6))
      '図形を描画する
      With ActiveDocument
        Set myShape = .Shapes.AddShape(msoShapeRectangle, xPos, yPos, boxWidth, boxHeigt)
        '図形の線のスタイル
        myShape.Line.DashStyle = msoLineSolid
        '図形の線種
        myShape.Line.Style = msoLineSingle
        '図形の線の太さ
        myShape.Line.Weight = 1.5
        '図形の線の色
        myShape.Line.ForeColor.RGB = RGB(0, 0, 0)
        '図形の線の透明度;0.0(不透明)~1.0(透明)
        myShape.Line.Transparency = 0
        '図形の線の表示
        myShape.Line.Visible = msoTrue
        '図形の塗り潰し
        myShape.Fill.Visible = msoFalse
        '図形の塗り潰し色
        myShape.Fill.ForeColor.RGB = RGB(255, 255, 255)
        '図形の透明度;0.0(不透明)~1.0(透明)
        myShape.Fill.Transparency = 1
      End With
    End Sub

    なお、用紙端からの距離については、エクセルの場合は、余白の取扱いがWordとは異なるのかもしれません。

    一応、それらしいコマンドを用意しているのであれば、Microsoftさんにもきちんと作り込んでほしいと思いますが、対応する気がないのでしょうねぇ。以上、ご参考まで。



    2019年6月6日 3:07
  • コーベルさん、こんにちは。

    たびたびで失礼します。根本的な原因と解決策は、わかりませんので、余計なお世話かもしれませんが。

    以前、図形の関係ではありませんが、エクセルの画面表示と印刷結果の不一致の解消策として採用した方策として、(1)画面の表示モードを印刷レイアウトにする。(2)プリンタの設定をFAXにする。(3)画面の印刷は、プリンタの設定をFAXのままPDFファイルに保存して、そのPDFファイルを印刷する。という手順でやって、何とかこの程度なら、というレベルになったことがありました。以上の手順の(1)と(2)はVBAで組み込むことができると思います。ご参考まで。


    2019年6月7日 0:13