在excel 的sheet中画坐标轴及函数图像

最新推荐文章于 2025-10-10 14:35:38 发布

原创

最新推荐文章于 2025-10-10 14:35:38 发布 · 2.6k 阅读

3 ·

CC 4.0 BY-SA版权

这篇博客详细介绍了如何在Excel的工作表中利用VBA代码绘制坐标轴及函数图像。首先，通过窗体配置参数，如横轴和纵轴的起点、长度等。然后，检查输入的数值是否正确，接着计算坐标轴交点和端点，并添加箭头。最后，绘制刻度线和值，以及在Excel中实现抛物线的绘制。

一、参数的窗体配置

二、窗体中三个按钮的代码：

Private Sub CommandButton1_Click()
    Dim X0 As Single, Y0 As Single, X1 As Single, Y1 As Single, X2 As Single, Y2 As Single
    Dim nX1 As Integer, nX As Integer, nY1 As Integer, nY As Integer, nL As Integer, nB As Integer, i As Integer, T1 As Integer
    Dim XLine As Shape, YLine As Shape, MyTextbox As Shape
    Dim ct As Single, M As Byte, MyValue As Single, ModValue As Byte

    On Error Resume Next ''忽略错误
    ''必要数据判断
    If Me.TextBox1 = "" Or Int(Me.TextBox1) <> Me.TextBox1 * 1 Or Me.TextBox1 * 1 <= 0 Then MsgBox "请输入正整数! ", vbInformation: Exit Sub
    If Me.TextBox2 = "" Or Int(Me.TextBox2) <> Me.TextBox2 * 1 Or Me.TextBox2 * 1 <= 0 Then MsgBox "请输入正整数! ", vbInformation: Exit Sub
    If Me.TextBox3 = "" Or Int(Me.TextBox3) <> Me.TextBox3 * 1 Or Me.TextBox3 * 1 < 0 Then MsgBox "请输入自然数! ", vbInformation: Exit Sub
    If Me.TextBox4 = "" Or Int(Me.TextBox4) <> Me.TextBox4 * 1 Or Me.TextBox4 * 1 <= 0 Then MsgBox "请输入正整数! ", vbInformation: Exit Sub
    If Me.TextBox5 = "" Or Int(Me.TextBox5) <> Me.TextBox5 * 1 Or Me.TextBox5 * 1 < 0 Then MsgBox "请输入自然数! ", vbInformation: Exit Sub
    If Me.TextBox6 = "" Or Int(Me.TextBox6) <> Me.TextBox6 * 1 Or Me.TextBox6 * 1 <= 0 Then MsgBox "请输入正整数! ", vbInformation: Exit Sub
    If Me.TextBox3 * 1 > Me.TextBox1 * 1 Or Me.TextBox6 * 1 > Me.TextBox2 * 1 Then MsgBox "无效数据!", vbInformation: Exit Sub

    Application.ScreenUpdating = False
    ''计算坐标轴交点及端点坐标，厘米转换为磅数,两端加长画箭头
    X0 = Application.CentimetersToPoints(Me.TextBox1)   '横轴原点的位置

    Y0 = Application.CentimetersToPoints(Me.TextBox2)'纵轴原点的位置
    T1 = Me.TextBox3 * 1
    X1 = X0 - Application.CentimetersToPoints(Me.TextBox3 + VBA.IIf(T1 > 0, 1, 0)) '负轴长为0时不加长
    X2 = X0 + Application.CentimetersToPoints(Me.TextBox4 + 1)

    T1 = Me.TextBox5 * 1
    Y1 = Y0 + Application.CentimetersToPoints(Me.TextBox5 + VBA.IIf(T1 > 0, 1, 0))
    Y2 = Y0 - Application.CentimetersToPoints(Me.TextBox6 + 1)

    With ActiveSheet                 'ActiveDocument
        '改名避免重复命名值出错
        BeforeShapes = .Shapes.Count   ''获取工作之前的图形总数
        If BeforeShapes >= 1 Then
              .Shapes.SelectAll: Selection.Delete
        End If

        '画轴