求助高手如何打印picture中的坐标曲线？？

Question

点击按钮后，下面代码画出的坐标系，可以形成供打印的文档，比如txt、word、excel等，有没有高手处理过类似的事情啊！
Private Sub drawline()
Dim xt As Single
Dim yt As Single
Dim XY As Single
Dim txt As String
Dim font_hgt As Single
Dim i As Integer
    '----------------------------确定picture区域范围,赋以具体的刻度值范围
    Picture3.Scale (-40000 \ 25, 5200)-(40000 + 40000 \ 40, -250)
    'Picture3.Scale (0, 5200)-(100 + 100 \ 40, -250)
    font_hgt = Picture3.TextHeight("X")
    Picture3.ForeColor = &HFF&
    Picture3.Line (0, 5000)-(40000, 5000)
    Picture3.Line (0, 5000)-(0, 0)
    Picture3.Line -(40000, 0)
    '----------------------------画纵轴
    Picture3.DrawStyle = vbDot
    For yt = 500 To 5000 Step 500
        Picture3.Line (0, yt)-(40000, yt)
        'txt = (Hex(yt))
        txt = yt
        Picture3.CurrentX = -Picture3.TextWidth(txt) * 1.1
        Picture3.CurrentY = yt - font_hgt / 2
        Picture3.Print txt
    Next yt
    Picture3.CurrentX = -Picture3.TextWidth(txt) * 1.1
    Picture3.CurrentY = 5000 - font_hgt / 2
    'Picture3.Print "FFF"
    '----------------------------画横轴
    For xt = 0 To 40000 Step Int(40000 / 20)
        Picture3.Line (xt, 0)-(xt, 5000)
        txt = Format$(xt)
        Picture3.CurrentX = xt - Picture3.TextWidth(txt) / 2
        Picture3.CurrentY = font_hgt / 3
        Picture3.Print txt
    Next xt
        Picture3.DrawStyle = vbSolid
    End Sub

Answer 1

复制整段代码，只需将Picture3全部改为Printer,保留原最后加一句Printer.EndDoc，就能完成打印。

Answer 2

Private Sub drawline()
Dim xt As Single
Dim yt As Single
Dim XY As Single
Dim txt As String
Dim font_hgt As Single
Dim i As Integer
    '----------------------------确定picture区域范围,赋以具体的刻度值范围
    Picture3.Scale (-40000 \ 25, 5200)-(40000 + 40000 \ 40, -250)
    'Picture3.Scale (0, 5200)-(100 + 100 \ 40, -250)
    font_hgt = Picture3.TextHeight("X")
    Picture3.ForeColor = &HFF&
    Picture3.Line (0, 5000)-(40000, 5000)
    Picture3.Line (0, 5000)-(0, 0)
    Picture3.Line -(40000, 0)
    '----------------------------画纵轴
    Picture3.DrawStyle = vbDot
    For yt = 500 To 5000 Step 500
        Picture3.Line (0, yt)-(40000, yt)
        'txt = (Hex(yt))
        txt = yt
        Picture3.CurrentX = -Picture3.TextWidth(txt) * 1.1
        Picture3.CurrentY = yt - font_hgt / 2
        Picture3.Print txt
    Next yt
    Picture3.CurrentX = -Picture3.TextWidth(txt) * 1.1
    Picture3.CurrentY = 5000 - font_hgt / 2
    'Picture3.Print "FFF"
    '----------------------------画横轴
    For xt = 0 To 40000 Step Int(40000 / 20)
        Picture3.Line (xt, 0)-(xt, 5000)
        txt = Format$(xt)
        Picture3.CurrentX = xt - Picture3.TextWidth(txt) / 2
        Picture3.CurrentY = font_hgt / 3
        Picture3.Print txt
    Next xt
        Picture3.DrawStyle = vbSolid
    End Sub
Private Sub Command1_Click()
    drawline
    VB.Clipboard.Clear
    VB.Clipboard.SetData Picture3.Image
    Shell "C:\Program Files\Microsoft Office\OFFICE11\WINWORD.EXE", vbNormalFocus
    ys 0.5
    SendKeys "^(v)"
    ys 0.5
    SendKeys "%fs"
    ys 1
    SendKeys "{1 3}" '我的文档里111.doc
    ys 0.5
    SendKeys "~"
    SendKeys "~"
    SendKeys "%fx"
    
'SavePicture Picture3.Image, "c:\1xx.bmp" '保存图片
End SubPrivate Sub Form_Load()
  Picture3.AutoRedraw = True
End SubPrivate Sub ys(ByVal t As Single)
   While Timer - y < t
     DoEvents
   Wend
End Sub

Answer 3

我用你的调试了，能打开空白word，但是没有word页内没有坐标。

Answer 4

'SavePicture Picture3.Image, "c:\1xx.bmp" '保存图片这一句，去掉前面的注释，WORD里就有图片了。

Answer 5

运行后，看C:\1.docPrivate Sub drawline()
Dim xt As Single
Dim yt As Single
Dim XY As Single
Dim txt As String
Dim font_hgt As Single
Dim i As Integer
    '----------------------------确定picture区域范围,赋以具体的刻度值范围
    Picture3.Scale (-40000 \ 25, 5200)-(40000 + 40000 \ 40, -250)
    'Picture3.Scale (0, 5200)-(100 + 100 \ 40, -250)
    font_hgt = Picture3.TextHeight("X")
    Picture3.ForeColor = &HFF&
    Picture3.Line (0, 5000)-(40000, 5000)
    Picture3.Line (0, 5000)-(0, 0)
    Picture3.Line -(40000, 0)
    '----------------------------画纵轴
    Picture3.DrawStyle = vbDot
    For yt = 500 To 5000 Step 500
        Picture3.Line (0, yt)-(40000, yt)
        'txt = (Hex(yt))
        txt = yt
        Picture3.CurrentX = -Picture3.TextWidth(txt) * 1.1
        Picture3.CurrentY = yt - font_hgt / 2
        Picture3.Print txt
    Next yt
    Picture3.CurrentX = -Picture3.TextWidth(txt) * 1.1
    Picture3.CurrentY = 5000 - font_hgt / 2
    'Picture3.Print "FFF"
    '----------------------------画横轴
    For xt = 0 To 40000 Step Int(40000 / 20)
        Picture3.Line (xt, 0)-(xt, 5000)
        txt = Format$(xt)
        Picture3.CurrentX = xt - Picture3.TextWidth(txt) / 2
        Picture3.CurrentY = font_hgt / 3
        Picture3.Print txt
    Next xt
        Picture3.DrawStyle = vbSolid
    End Sub
Private Sub Command1_Click()
   drawline
   VB.Clipboard.Clear
   VB.Clipboard.SetData Picture3.Image   Dim WordApp As Object, Mydoc As Object
   Set WordApp = CreateObject("Word.Application")
   'WordApp.Application.Visible = 1
   Set Mydoc = WordApp.Documents.Add()
   WordApp.Application.Selection.Paste
   With Mydoc
    .SaveAs FileName:="c:\1.doc" '//////////////////////////
    .Close
   End With
   WordApp.Quit
   Set WordApp = Nothing
   Set Mydoc = Nothing
   
End SubPrivate Sub Form_Load()
  Picture3.AutoRedraw = True
End Sub

Answer 6

SavePicture Picture3.Image, "c:\1xx.bmp" '保存图片
这一句是单保存图片用的与word没有关系