曲线问题

szwanghuan 2003-04-24 12:35:06
请问:怎么在excel中画一条任意的曲线,如果有picturebox就好了!
请指教!谢谢!
...全文
86 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
szwanghuan 2003-05-27
  • 打赏
  • 举报
回复
感谢icansaymyabc(学习进步) !
szwanghuan 2003-05-27
  • 打赏
  • 举报
回复
看来没人能帮我了,准备散分走人!
szwanghuan 2003-05-26
  • 打赏
  • 举报
回复
to user_hj(office之友)
能在VB中做我就不在office中做了

我把我想做的东西说一下吧。
我做的是试验软件,客户需要打试验报告,试验报告需要有试验曲线,试验数据保存在Access数据库中,每个客户的试验报告格式都不一样,我想做一个东东,客户可以自己设计报告格式。我试过用友的cell和水晶报表,都不能很好的满足我的要求,只好用Excel试下。

不知大家是否有更好方法?

to icansaymyabc(学习进步)
那可能是这个原因吧,我的试验曲线最少有1000多个点。
我也试过用添加图表的方式,可也遇到了问题,见:
http://expert.csdn.net/Expert/topic/1833/1833658.xml?temp=.7944147

我该怎么办啊!
神啊!救救我!
icansaymyabc 2003-05-24
  • 打赏
  • 举报
回复
相邻的两点不能重合。不相邻的点最好也避免重合。

同时,由于诸多原因,Excel里面 (x,y)(x+1,y)(x-1,y+1) 这种相隔很近的点被视为重合。
szwanghuan 2003-05-23
  • 打赏
  • 举报
回复
icansaymyabc(学习与进步)

可能是我太菜,要不就是微软坏菜!
您的函数可远行并画出曲线,可我的确报错:msoEditingAuto变量未定义!或就是报:ConvertToShape对象不可用。

您帮我看看我这个函数好吗?
分不够另开贴给分,您开个价!只要我有啊!

Public Sub DrawCurve()
Dim x() As Single, y() As Single, i As Long, j As Long, k As Long
Dim tmpMax As ADODB.Recordset
Dim tmpRecordset As ADODB.Recordset
Dim YMaxName As String
Dim XMaxName As String
Dim XMax As Single
Dim YMax As Single
Dim tmpLoad As Single
Dim tmpDeform As Single
Dim tmpTime As Single
Dim tmpExt As Single

On Error Resume Next


Set tmpMax = New ADODB.Recordset


'查找X轴最大值
Select Case DisplayCurve.XMode
Case "力"
XMaxName = "LoadValue"
DisplayCurve.XUnit = "N"
Case "变形"
XMaxName = "ExtendValue"
DisplayCurve.XUnit = "mm"
Case "位移"
XMaxName = "PositionValue"
DisplayCurve.XUnit = "mm"
Case "时间"
XMaxName = "PlayTime"
DisplayCurve.XUnit = "s"
Case "应力"
XMaxName = "LoadValue"
DisplayCurve.XUnit = "MPa"
Case "应变"
XMaxName = "ExtendValue"
DisplayCurve.XUnit = "%"
End Select

tmpMax.Open "SELECT MAX(" & XMaxName & ") AS 最高 FROM OriginalData", dbsTestDataMain, adOpenKeyset, adLockOptimistic

XMax = tmpMax.Fields("最高")

tmpMax.Close

'查找Y轴最大值
Select Case DisplayCurve.YMode
Case "力"
YMaxName = "LoadValue"
DisplayCurve.YUnit = "N"
Case "变形"
YMaxName = "ExtendValue"
DisplayCurve.YUnit = "mm"
Case "位移"
YMaxName = "PositionValue"
DisplayCurve.YUnit = "mm"
Case "时间"
YMaxName = "PlayTime"
DisplayCurve.YUnit = "s"
Case "应力"
YMaxName = "LoadValue"
DisplayCurve.YUnit = "MPa"
Case "应变"
YMaxName = "ExtendValue"
DisplayCurve.YUnit = "%"
End Select


tmpMax.Open "SELECT MAX(" & YMaxName & ") AS 最高 FROM OriginalData", dbsTestDataMain, adOpenKeyset, adLockOptimistic

YMax = tmpMax.Fields("最高")

tmpMax.Close


DisplayCurve.XMin = 0
DisplayCurve.YMin = 0

'如果力大于1000N则用kN作单位
If DisplayCurve.XUnit = "N" And XMax > 1000 Then
DisplayCurve.XUnit = "kN"
XMax = XMax / 1000
End If
If DisplayCurve.YUnit = "N" And YMax > 1000 Then
DisplayCurve.YUnit = "kN"
YMax = YMax / 1000
End If

'自适应座标满度
PTDispCurveStru DisplayCurve, XMax, YMax

'画座标网格
DrawMark

'填写座标标记
Write_Coor_Mark


'画曲线
For i = 1 To DisplayCurve.TestNumber

'在原始数据表中分别搜索每根试样的数据
Set tmpRecordset = New ADODB.Recordset
tmpRecordset.Open "Select * From OriginalData Where TestNo = " & SCurve(i).TestNo & " Order by ID ASC", dbsTestDataMain, adOpenKeyset, adLockOptimistic

ReDim x(0 To tmpRecordset.RecordCount - 1)
ReDim y(0 To tmpRecordset.RecordCount - 1)


'原点座标
x(0) = DisplayCurve.Left
y(0) = DisplayCurve.Height + DisplayCurve.Top

k = 0

'每隔5个采样点画条直线
For j = 0 To tmpRecordset.RecordCount - 5 Step 5

k = k + 1

'取原始数据
If DisplayCurve.YUnit = "kN" Or DisplayCurve.XUnit = "kN" Then
tmpLoad = tmpRecordset.Fields("LoadValue") / 1000
Else
tmpLoad = tmpRecordset.Fields("LoadValue")
End If
tmpTime = tmpRecordset.Fields("PlayTime")
tmpDeform = tmpRecordset.Fields("PositionValue")
tmpExt = tmpRecordset.Fields("ExtendValue")

'计算当前点X轴座标
Select Case DisplayCurve.XMode
Case "力"
x(k) = DisplayCurve.Left + (tmpLoad - DisplayCurve.XMin) * DisplayCurve.Width / (DisplayCurve.XMax - DisplayCurve.XMin)
Case "位移"
x(k) = DisplayCurve.Left + (tmpDeform - DisplayCurve.XMin) * DisplayCurve.Width / (DisplayCurve.XMax - DisplayCurve.XMin)
Case "变形"
x(k) = DisplayCurve.Left + (tmpExt - DisplayCurve.XMin) * DisplayCurve.Width / (DisplayCurve.XMax - DisplayCurve.XMin)
Case "时间"
x(k) = DisplayCurve.Left + (tmpTime - DisplayCurve.XMin) * DisplayCurve.Width / (DisplayCurve.XMax - DisplayCurve.XMin)
Case "应力"
x(k) = DisplayCurve.Left + (tmpLoad / SCurve(i).Area - DisplayCurve.XMin) * DisplayCurve.Width / (DisplayCurve.XMax - DisplayCurve.XMin)
Case "应变"
x(k) = DisplayCurve.Left + (tmpLoad / SCurve(i).L0 * 100 - DisplayCurve.XMin) * DisplayCurve.Width / (DisplayCurve.XMax - DisplayCurve.XMin)
End Select

'计算当前点Y轴座标
Select Case DisplayCurve.YMode
Case "力"
x(k) = DisplayCurve.Top + DisplayCurve.Height - (tmpLoad - DisplayCurve.YMin) * DisplayCurve.Height / (DisplayCurve.YMax - DisplayCurve.YMin)
Case "位移"
x(k) = DisplayCurve.Top + DisplayCurve.Height - (tmpDeform - DisplayCurve.YMin) * DisplayCurve.Height / (DisplayCurve.YMax - DisplayCurve.YMin)
Case "变形"
x(k) = DisplayCurve.Top + DisplayCurve.Height - (tmpExt - DisplayCurve.YMin) * DisplayCurve.Height / (DisplayCurve.YMax - DisplayCurve.YMin)
Case "时间"
x(k) = DisplayCurve.Top + DisplayCurve.Height - (tmpTime - DisplayCurve.YMin) * DisplayCurve.Height / (DisplayCurve.YMax - DisplayCurve.YMin)
Case "应力"
x(k) = DisplayCurve.Top + DisplayCurve.Height - (tmpLoad / SCurve(i).Area - DisplayCurve.YMin) * DisplayCurve.Height / (DisplayCurve.YMax - DisplayCurve.YMin)
Case "应变"
x(k) = DisplayCurve.Top + DisplayCurve.Height - (tmpLoad / SCurve(i).L0 * 100 - DisplayCurve.YMin) * DisplayCurve.Height / (DisplayCurve.YMax - DisplayCurve.YMin)
End Select

tmpRecordset.MoveNext
tmpRecordset.MoveNext
tmpRecordset.MoveNext
tmpRecordset.MoveNext
tmpRecordset.MoveNext

Next j

tmpRecordset.Close
Set tmpRecordset = Nothing

With Sheet1.Shapes.BuildFreeform(msoEditingAuto, x(0), y(0))

For j = 1 To k
.AddNodes msoSegmentCurve, msoEditingAuto, x(j), y(j)
Next j
.ConvertToShape
End With

Next i

dbsTestData.Close
dbsTestDataMain.Close
Set dbsTestData = Nothing
Set dbsTestDataMain = Nothing

End Sub
user_hj 2003-05-23
  • 打赏
  • 举报
回复
同志们啊,那还不如就在VB中画更简单,何必在Excel中做。
如果要在Excel中做就应该充分利用Excel的特点。

可惜,在这里转了老半天,到处可以看到技术被滥用的情况。
不能说各位做得不对,但是没有针对不同工具采用不同方法,
也没对不同的需求选用不同的工具。就好比打坦克用大炮,
打蚊子也用大炮。
szwanghuan 2003-05-23
  • 打赏
  • 举报
回复
不对啊
我在你给程序中加入如下语句
x(10)=x(1)
y(10)=Y(1)
程序运行正常
szwanghuan 2003-05-23
  • 打赏
  • 举报
回复
数据环境应该没问题。
单是X值或单是Y值重复也不行吗?
icansaymyabc 2003-05-23
  • 打赏
  • 举报
回复
你的程序不是平白就能运行的,需要你的数据环境支持,我这里编译都不通过,无法调试。
没法帮你了。

只能给你提个醒,用于绘图的数组中不能有重合的点。你自己检查一下吧。
icansaymyabc 2003-05-21
  • 打赏
  • 举报
回复
'你怎么就这样冥顽不灵?什么都要人家帮你做好
Sub AAAAA()
Dim x(10) As Single, y(10) As Single, th As Single, i As Long

For i = 0 To 10
x(i) = th * 50 + 50
y(i) = Sin(th) * 100 + 150
th = th + 0.628
Next

With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, x(0), y(0))
For i = 1 To 10
.AddNodes msoSegmentCurve, msoEditingAuto, x(i), y(i)
Next
.ConvertToShape
End With
End Sub

szwanghuan 2003-05-21
  • 打赏
  • 举报
回复
等待中.....
请高手帮忙!
不胜感激!
szwanghuan 2003-05-19
  • 打赏
  • 举报
回复
icansaymyabc(学习与进步)

我有试过你所说的方法,可我的x,y值是未知并且有规律变化的
如:

Dim i As Integer
Dim x As Single
Dim y As Single

x = 78
y = 63.75

With ActiveSheet.Shapes.BuildFreeform(msoEditingCorner, 78#, 63.75)
For i = 1 To 100
x = x + 1
y = y + 1
.AddNodes msoSegmentCurve, msoEditingCorner, x, y
Next i
.ConvertToShape.Select
End With

可是程序总是报错:应用程序定义或对象定义错误。错误处是
.ConvertToShape.Select

把.ConvertToShape.Select放在.AddNodes 后面也报同样的错,
该怎么办啊?
虚心请教!
icansaymyabc 2003-04-24
  • 打赏
  • 举报
回复
'或者运行这段VBA程序
Sub Macro1()
With ActiveSheet.Shapes.BuildFreeform(msoEditingCorner, 78#, 63.75)
.AddNodes msoSegmentCurve, msoEditingCorner, 78.75, 77.25, 82.5, 101.25, _
94.5, 110.25
.AddNodes msoSegmentCurve, msoEditingCorner, 97.5, 115.5, 102.75, 121.5, _
108.75, 123#
.AddNodes msoSegmentCurve, msoEditingCorner, 111.75, 126#, 116.25, 127.5, _
120.75, 128.25
.AddNodes msoSegmentCurve, msoEditingCorner, 129#, 127.5, 136.5, 127.5, _
144#, 125.25
.AddNodes msoSegmentCurve, msoEditingCorner, 146.25, 123#, 147#, 120.75, _
149.25, 118.5
.AddNodes msoSegmentCurve, msoEditingCorner, 148.5, 114#, 147#, 106.5, _
143.25, 102.75
.AddNodes msoSegmentCurve, msoEditingCorner, 141.75, 98.25, 138.75, 96.75, _
135#, 95.25
.AddNodes msoSegmentCurve, msoEditingCorner, 122.25, 96.75, 120#, 98.25, _
110.25, 100.5
.AddNodes msoSegmentCurve, msoEditingCorner, 108#, 102.75, 107.25, 105#, _
105#, 108#
.AddNodes msoSegmentCurve, msoEditingCorner, 104.25, 109.5, 104.25, 111#, _
103.5, 112.5
.AddNodes msoSegmentCurve, msoEditingCorner, 102.75, 114#, 102#, 114.75, _
101.25, 116.25
.AddNodes msoSegmentCurve, msoEditingCorner, 100.5, 117.75, 99.75, 120.75, _
99.75, 120.75
.AddNodes msoSegmentCurve, msoEditingCorner, 99.75, 126.75, 99#, 140.25, _
102#, 148.5
.AddNodes msoSegmentCurve, msoEditingCorner, 114#, 179.25, 140.25, 192.75, _
171#, 198#
.AddNodes msoSegmentCurve, msoEditingCorner, 179.25, 198#, 186.75, 198#, _
195#, 197.25
.AddNodes msoSegmentCurve, msoEditingCorner, 200.25, 196.5, 209.25, 188.25, _
209.25, 188.25
.AddNodes msoSegmentCurve, msoEditingCorner, 211.5, 185.25, 213.75, 182.25, _
215.25, 178.5
.AddNodes msoSegmentCurve, msoEditingCorner, 219#, 158.25, 209.25, 147.75, _
191.25, 145.5
.AddNodes msoSegmentCurve, msoEditingCorner, 162#, 146.25, 155.25, 138.75, _
144#, 157.5
.AddNodes msoSegmentCurve, msoEditingCorner, 142.5, 162.75, 141#, 168#, _
138.75, 172.5
.AddNodes msoSegmentCurve, msoEditingCorner, 144#, 214.5, 186#, 243#, _
226.5, 245.25
.AddNodes msoSegmentCurve, msoEditingCorner, 267.75, 243#, 298.5, 226.5, _
327.75, 197.25
.AddNodes msoSegmentCurve, msoEditingCorner, 342#, 154.5, 316.5, 111.75, _
270.75, 104.25
.AddNodes msoSegmentCurve, msoEditingCorner, 257.25, 105#, 258#, 107.25, _
254.25, 118.5
.AddNodes msoSegmentCurve, msoEditingCorner, 246#, 176.25, 297.75, 225#, _
351.75, 231#
.AddNodes msoSegmentCurve, msoEditingCorner, 363.75, 230.25, 376.5, 231.75, _
387#, 224.25
.AddNodes msoSegmentCurve, msoEditingCorner, 393#, 220.5, 404.25, 212.25, _
404.25, 212.25
.AddNodes msoSegmentCurve, msoEditingCorner, 411.75, 201.75, 413.25, 196.5, _
418.5, 185.25
.AddNodes msoSegmentCurve, msoEditingCorner, 420.75, 148.5, 417#, 121.5, _
388.5, 97.5
.AddNodes msoSegmentCurve, msoEditingCorner, 386.25, 93#, 380.25, 84#, _
380.25, 84#
.AddNodes msoSegmentCurve, msoEditingCorner, 376.5, 72.75, 368.25, 62.25, _
356.25, 59.25
.AddNodes msoSegmentCurve, msoEditingCorner, 339.75, 60.75, 347.25, 63#, _
348.75, 86.25
.AddNodes msoSegmentCurve, msoEditingCorner, 351#, 115.5, 375.75, 130.5, _
400.5, 139.5
.AddNodes msoSegmentCurve, msoEditingCorner, 433.5, 138.75, 465#, 153#, _
479.25, 123.75
.AddNodes msoSegmentCurve, msoEditingCorner, 489#, 56.25, 420#, 42.75, _
372#, 27#
.AddNodes msoSegmentCurve, msoEditingCorner, 381.75, 43.5, 400.5, 45.75, _
416.25, 54.75
.AddNodes msoSegmentCurve, msoEditingCorner, 423.75, 59.25, 435#, 70.5, _
443.25, 72#
.AddNodes msoSegmentCurve, msoEditingCorner, 449.25, 76.5, 458.25, 82.5, _
465.75, 84.75
.AddNodes msoSegmentCurve, msoEditingCorner, 474#, 90#, 500.25, 100.5, _
510#, 102.75
.AddNodes msoSegmentCurve, msoEditingCorner, 513#, 105#, 513.75, 106.5, _
517.5, 107.25
.AddNodes msoSegmentCurve, msoEditingCorner, 519.75, 108.75, 522.75, 113.25, _
522.75, 113.25
.ConvertToShape.Select
End With
Range("A3").Select
End Sub
icansaymyabc 2003-04-24
  • 打赏
  • 举报
回复
拿油性水笔在屏幕上描出来。
qiuafa 2003-04-24
  • 打赏
  • 举报
回复
劫分&捧场

5,139

社区成员

发帖
与我相关
我的任务
社区描述
其他开发语言 Office开发/ VBA
社区管理员
  • Office开发/ VBA社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧