将量取的长度进行累加的求助

jsxygshh

2. Public Xlapp As Object
   
3. Private Sub Command4_Click() '测量长度
   
4.     Set Xlapp = GetObject(, "Excel.Application")
   
5.     Dim PT1 As Variant
   
6.     Dim Dis As Double
   
7.     On Error Resume Next
   
8. label:
   
9.         PT1 = ThisDrawing.Utility.GetPoint(, "1st Point")
   
10.         Dis = Format(ThisDrawing.Utility.GetDistance(PT1, "2nd Point") / 1000, "##0.00")
    
11.         Xlapp.ActiveCell = Dis
    
12.         Xlapp.ActiveCell.Offset(1, 0).Select
    
13.         If Err Then
    
14.             Exit Sub
    
15.         Else
    
16.             GoTo label
    
17.         End If
    
18. End Sub

Public Xlapp As Object<br /> Private Sub Command4_Click() '测量长度<br />     Set Xlapp = GetObject(, "Excel.Application")<br />     Dim PT1 As Variant<br />     Dim Dis As Double<br />     On Error Resume Next<br /> label:<br />         PT1 = ThisDrawing.Utility.GetPoint(, "1st Point")<br />         Dis = Format(ThisDrawing.Utility.GetDistance(PT1, "2nd Point") / 1000, "##0.00")<br />         Xlapp.ActiveCell = Dis<br />         Xlapp.ActiveCell.Offset(1, 0).Select<br />         If Err Then<br />             Exit Sub<br />         Else<br />             GoTo label<br />         End If<br /> End Sub

急用,在线等

jsxygshh

请大家不吝赐教,先谢谢

markc0826

2.     Dim xlapp As Excel.Application
   
3.         On Error Resume Next
   
4.         Set xlapp = getObject(, "Excel.Application")
   
5.         If Err Then
   
6.             MsgBox "Please Run the Excel first !! "
   
7.             Err.Clear
   
8.             Exit Sub
   
9.         End If
   
10.    
    
11.     Dim PT1 As Variant
    
12.     Dim Dis As Double
    
13. 
    
14. label:
    
15.         PT1 = ThisDrawing.Utility.getPoint(, "1st Point")
    
16.         Dis = Format(ThisDrawing.Utility.GetDistance(PT1, "2nd Point") / 1000, "##0.00")
    
17.         xlapp.ActiveCell = Dis
    
18.         xlapp.ActiveCell.Offset(1, 0).Select
    
19.         If Err Then
    
20.             Me.Show
    
21.             Exit Sub
    
22.         Else
    
23.             GoTo label
    
24.         End If

    Dim xlapp As Excel.Application<br />         On Error Resume Next<br />         Set xlapp = getObject(, "Excel.Application")<br />         If Err Then<br />             MsgBox "Please Run the Excel first !! "<br />             Err.Clear<br />             Exit Sub<br />         End If<br />     <br />     Dim PT1 As Variant<br />     Dim Dis As Double<br /> <br /> label:<br />         PT1 = ThisDrawing.Utility.getPoint(, "1st Point")<br />         Dis = Format(ThisDrawing.Utility.GetDistance(PT1, "2nd Point") / 1000, "##0.00")<br />         xlapp.ActiveCell = Dis<br />         xlapp.ActiveCell.Offset(1, 0).Select<br />         If Err Then<br />             Me.Show<br />             Exit Sub<br />         Else<br />             GoTo label<br />         End If

Flyingdancing

2. Public Xlapp As Object
   
3. Private Sub Command1_Click() '测量长度
   
4. 
   
5. '连接外部程序最好添加错误处理机制：
   
6. On Error Resume Next
   
7. Set Xlapp = GetObject(, "Excel.Application")
   
8. If Err Then
   
9.     Err.Clear '如果不clear，则err仍然存在
   
10.     MsgBox "请先打开EXCEL！", vbInformation, "提示"
    
11.     '或者新建EXCEL程序
    
12.     '新建的仍然是application对象
    
13.     Set Xlapp = CreateObject("excel.application")
    
14.     '或者：
    
15.     If MsgBox("EXCEL还没有打开，是否新建EXCEL？", vbInformation, "提示") = vbYes Then
    
16.         Set Xlapp = CreateObject("excel.application")
    
17.         '显示新建的EXCEL程序,否则操作完除了后续用命令保存，将不能手动修改及显示
    
18.         Xlapp.Visible = True
    
19.         
    
20.     Else
    
21.         Exit Sub
    
22.     End If
    
23. End If 'application对象一整套处理完成
    
24. 
    
25. '此处只是application
    
26. 'application对象往后才是workbook，接着才是worksheet
    
27. 'activecells，也就是cells对象必须是在worksheet对象后面的
    
28. '所以下面是建立worksheet对象
    
29. '当然因为你要用窗体，下面的dim换成public
    
30. Dim Xlbook As Object '存储workbook对象
    
31. Dim Xlsheet As Object '存储worksheet对象
    
32. Set Xlbook = Xlapp.workbooks.Add
    
33. 'set xlbook=xlapp.workbooks(i)  '此处i自定义，用于打开多工作簿的情况'可添加列表框提供手选功能
    
34. Set Xlsheet = Xlbook.worksheet(1) '同样可以用add功能
    
35. '具体excel就不多说了。模型对象再学习吧
    
36. '如此，把下面xlapp全部改成xlsheet就行了
    
37. 
    
38. 
    
39. Dim PT1 As Variant
    
40. Dim Dis As Double
    
41. On Error Resume Next
    
42. label:
    
43. '注意，任何用到窗体的，并且需要进行图形操作的，譬如get**操作
    
44. '在之前都要先隐藏掉窗体'不需要图形操作仅仅纯计算及文字处理的<可>不隐藏
    
45. Me.Hide '后面操作完再显示，这个hide一般放在最前面
    
46.     PT1 = ThisDrawing.Utility.GetPoint(, "1st Point")
    
47.     Dis = Format(ThisDrawing.Utility.GetDistance(PT1, "2nd Point") / 1000, "##0.00")
    
48.     Xlapp.ActiveCell = Dis
    
49.     Xlapp.ActiveCell.Offset(1, 0).Select
    
50.     If Err Then
    
51.         Exit Sub
    
52.     Else
    
53.         GoTo label
    
54.     End If
    
55. '最后退出时要清空外部链接
    
56. '注意不是放在这里，现在放这里只是为了方便说明
    
57. '要放在你不再用到EXCEL程序的后面执行
    
58. Set Xlapp = Nothing
    
59. Set Xlbook = Nothing
    
60. Set Xlsheet = Nothing
    
61. '最后
    
62. Me.Show
    
63. '若要支持窗体显示的同时仍然可以操作图形
    
64. Me.Show 0 '称为非模态，上面为模态
    
65. End Sub

Public Xlapp As Object<br /> Private Sub Command1_Click() '测量长度<br /> <br /> '连接外部程序最好添加错误处理机制：<br /> On Error Resume Next<br /> Set Xlapp = GetObject(, "Excel.Application")<br /> If Err Then<br />     Err.Clear '如果不clear，则err仍然存在<br />     MsgBox "请先打开EXCEL！", vbInformation, "提示"<br />     '或者新建EXCEL程序<br />     '新建的仍然是application对象<br />     Set Xlapp = CreateObject("excel.application")<br />     '或者：<br />     If MsgBox("EXCEL还没有打开，是否新建EXCEL？", vbInformation, "提示") = vbYes Then<br />         Set Xlapp = CreateObject("excel.application")<br />         '显示新建的EXCEL程序,否则操作完除了后续用命令保存，将不能手动修改及显示<br />         Xlapp.Visible = True<br />         <br />     Else<br />         Exit Sub<br />     End If<br /> End If 'application对象一整套处理完成<br /> <br /> '此处只是application<br /> 'application对象往后才是workbook，接着才是worksheet<br /> 'activecells，也就是cells对象必须是在worksheet对象后面的<br /> '所以下面是建立worksheet对象<br /> '当然因为你要用窗体，下面的dim换成public<br /> Dim Xlbook As Object '存储workbook对象<br /> Dim Xlsheet As Object '存储worksheet对象<br /> Set Xlbook = Xlapp.workbooks.Add<br /> 'set xlbook=xlapp.workbooks(i)  '此处i自定义，用于打开多工作簿的情况'可添加列表框提供手选功能<br /> Set Xlsheet = Xlbook.worksheet(1) '同样可以用add功能<br /> '具体excel就不多说了。模型对象再学习吧<br /> '如此，把下面xlapp全部改成xlsheet就行了<br /> <br /> <br /> Dim PT1 As Variant<br /> Dim Dis As Double<br /> On Error Resume Next<br /> label:<br /> '注意，任何用到窗体的，并且需要进行图形操作的，譬如get**操作<br /> '在之前都要先隐藏掉窗体'不需要图形操作仅仅纯计算及文字处理的<可>不隐藏<br /> Me.Hide '后面操作完再显示，这个hide一般放在最前面<br />     PT1 = ThisDrawing.Utility.GetPoint(, "1st Point")<br />     Dis = Format(ThisDrawing.Utility.GetDistance(PT1, "2nd Point") / 1000, "##0.00")<br />     Xlapp.ActiveCell = Dis<br />     Xlapp.ActiveCell.Offset(1, 0).Select<br />     If Err Then<br />         Exit Sub<br />     Else<br />         GoTo label<br />     End If<br /> '最后退出时要清空外部链接<br /> '注意不是放在这里，现在放这里只是为了方便说明<br /> '要放在你不再用到EXCEL程序的后面执行<br /> Set Xlapp = Nothing<br /> Set Xlbook = Nothing<br /> Set Xlsheet = Nothing<br /> '最后<br /> Me.Show<br /> '若要支持窗体显示的同时仍然可以操作图形<br /> Me.Show 0 '称为非模态，上面为模态<br /> End Sub

Flyingdancing

建议修改下标题，突出EXCEL连接、操作等关键字

blackfire

把长度导入excel自动求和

sxz4494

你这样需要确定2点，可以只要选择多段线，就可以显示长度，或者更多的比如，选择文字，就可以把文字输入到excel呢