none
With Activesheet.Shapes.AddLine(x1,y1,x2,y2).Line で描画したLineをPDFに出力すると空白となる。 RRS feed

  • 質問

  • Sheet1に503行×502列のデータを読み込み、Sheet2に描画する、下記マクロ(VBA)を実行すると、セルに出力した数字だけがPDFに出力され、描画したLineが空白となる。解決方法を知りたい。以下にマクロを記す。

        Dim ix1 As Integer
        Dim iy1 As Integer
        Dim ix2 As Integer
        Dim iy2 As Integer
       
        Dim iiy1 As Integer
        Dim iyk2 As Integer
        Dim ix11 As Integer
        Dim ix21 As Integer
        Dim icol(20) As Integer
        icol(1) = 92
        icol(2) = 5
        icol(3) = 41
        icol(4) = 33
        icol(5) = 8
        icol(6) = 4
        icol(7) = 21
        icol(8) = 10
        icol(9) = 29
        icol(10) = 50
        icol(11) = 6
        icol(12) = 18
        icol(13) = 26
        icol(14) = 40
        icol(15) = 44
        icol(16) = 45
        icol(17) = 48
        icol(18) = 53
        icol(19) = 3
       
        Dim jun(512, 512)
       
        Dim c As Range
        Dim f(513) As Single
        Dim dx As Single
        Dim dy As Single
       
        Application.ScreenUpdating = False
     
        On Error Resume Next
        Sheets("sheet2").Select
        AllDrawingObjectDElete
        Sheets("Sheet1").Select
        AllDrawingObjectDElete
        Worksheets("sheet1").rang("A:H").ColumnWidth = 12
    '
        Sheets("sheet1").Select
        '
       
        nn = Worksheets("sheet1").Range("A1")
        xax = Worksheets("sheet1").Range("B1")
        yax = Worksheets("sheet1").Range("C1")
        hantei = Worksheets("sheet1").Range("D1")
       
       
        [A2].Select
        fxe = ActiveCell.Offset(nn, 0).Value
        fxs = ActiveCell.Offset(1, 0).Value
        dx = (fxe - fxs) / (nn - 1)
        For i = 1 To nn
        f(i) = dx * (i - 1) + fxs
        Next i
           
        Set rngstart = Worksheets("sheet2").Range("B25")
        xs = rngstart.Left
        ys = rngstart.Top
        Set rngend = Worksheets("sheet2").Range("H2")
        xe = rngend.Left
        ye = ys - (xe - xs)
        ax = xe - xs
        ay = (ye - ys)
      
        cx = ax / 10#
        cy = ay / 10#
       
        ax3 = ax - cx
       
        dx = ax / (fxe - fxs)
        dy = ay / (fxe - fxs)
        xg = (xe - xs) * (-fxs / (fxe - fxs)) + xs
        yg = (ye - ys) * (-fxs / (fxe - fxs)) + ys
       
        scalx = bx * (fxe - fxs) / 10#
        scxa = cx / 20#
        scya = cy / 20#
        cx7 = cx / 10#
        Sheets("sheet1").Select
        [A2].Select
        For i = 1 To nn
        For j = 1 To nn
        jun(i, j) = ActiveCell.Offset(i + 1, j).Value
        Next j
        Next i

        Sheets("sheet2").Select
        For i = 1 To nn
        For j = 1 To nn - 1
        xn = f(j)
        x1 = xg + dx * xn
        x2 = xg + dx * f(j + 1)
        yn = f(i)
        y1 = yg + dy * yn
        y2 = y1

        jcolor = icol(jun(i, j))
        
        With ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Line
            .ForeColor.SchemeColor = jcolor
            .Weight = 1.5
        End With
       
        Next
        Next
        [A1].Select
        ActiveCell.Offset(1, 0).Value = xax
        ActiveCell.Offset(1, 1).Value = yax
        ActiveCell.Offset(1, 2).Value = f(nn)
        ActiveCell.Offset(1, 3).Value = hantei
        ActiveCell.Offset(38, 7).Value = xax

    以上

    2016年4月7日 10:49

すべての返信

  • すみません。質問ですが、

    「画面上では、線分は表示されているが、PDFに出力すると線分だけ出力されない」

    ということでよろしかったでしょうか?

    PDFにはどのように出力されているのでしょうか?
    (例えば、「名前を付けて保存」、「エクスポート」、「印刷」など考えられます)

    また、Excelのバージョンは何になりますでしょうか?

    #追伸

    オーダーでnnの2乗回線分が描画されるようですが、nnの値を小さくしたときは正しくPDFに出力されますでしょうか?


    2016年4月7日 11:11