jsxygshh 发表于 2012-11-18 19:53:49

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

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



jsxygshh 发表于 2012-11-18 20:12:46

请大家不吝赐教,先谢谢

markc0826 发表于 2012-11-22 18:21:52

    Dim xlapp As Excel.Application
      On Error Resume Next
      Set xlapp = getObject(, "Excel.Application")
      If Err Then
            MsgBox "Please Run the Excel first !! "
            Err.Clear
            Exit Sub
      End If
   
    Dim PT1 As Variant
    Dim Dis As Double

label:
      PT1 = ThisDrawing.Utility.getPoint(, "1st Point")
      Dis = Format(ThisDrawing.Utility.GetDistance(PT1, "2nd Point") / 1000, "##0.00")
      xlapp.ActiveCell = Dis
      xlapp.ActiveCell.Offset(1, 0).Select
      If Err Then
            Me.Show
            Exit Sub
      Else
            GoTo label
      End If

Flyingdancing 发表于 2012-11-22 19:54:08

Public Xlapp As Object
Private Sub Command1_Click() '测量长度

'连接外部程序最好添加错误处理机制：
On Error Resume Next
Set Xlapp = GetObject(, "Excel.Application")
If Err Then
    Err.Clear '如果不clear，则err仍然存在
    MsgBox "请先打开EXCEL！", vbInformation, "提示"
    '或者新建EXCEL程序
    '新建的仍然是application对象
    Set Xlapp = CreateObject("excel.application")
    '或者：
    If MsgBox("EXCEL还没有打开，是否新建EXCEL？", vbInformation, "提示") = vbYes Then
      Set Xlapp = CreateObject("excel.application")
      '显示新建的EXCEL程序,否则操作完除了后续用命令保存，将不能手动修改及显示
      Xlapp.Visible = True
      
    Else
      Exit Sub
    End If
End If 'application对象一整套处理完成

'此处只是application
'application对象往后才是workbook，接着才是worksheet
'activecells，也就是cells对象必须是在worksheet对象后面的
'所以下面是建立worksheet对象
'当然因为你要用窗体，下面的dim换成public
Dim Xlbook As Object '存储workbook对象
Dim Xlsheet As Object '存储worksheet对象
Set Xlbook = Xlapp.workbooks.Add
'set xlbook=xlapp.workbooks(i)'此处i自定义，用于打开多工作簿的情况'可添加列表框提供手选功能
Set Xlsheet = Xlbook.worksheet(1) '同样可以用add功能
'具体excel就不多说了。模型对象再学习吧
'如此，把下面xlapp全部改成xlsheet就行了


Dim PT1 As Variant
Dim Dis As Double
On Error Resume Next
label:
'注意，任何用到窗体的，并且需要进行图形操作的，譬如get**操作
'在之前都要先隐藏掉窗体'不需要图形操作仅仅纯计算及文字处理的<可>不隐藏
Me.Hide '后面操作完再显示，这个hide一般放在最前面
    PT1 = ThisDrawing.Utility.GetPoint(, "1st Point")
    Dis = Format(ThisDrawing.Utility.GetDistance(PT1, "2nd Point") / 1000, "##0.00")
    Xlapp.ActiveCell = Dis
    Xlapp.ActiveCell.Offset(1, 0).Select
    If Err Then
      Exit Sub
    Else
      GoTo label
    End If
'最后退出时要清空外部链接
'注意不是放在这里，现在放这里只是为了方便说明
'要放在你不再用到EXCEL程序的后面执行
Set Xlapp = Nothing
Set Xlbook = Nothing
Set Xlsheet = Nothing
'最后
Me.Show
'若要支持窗体显示的同时仍然可以操作图形
Me.Show 0 '称为非模态，上面为模态
End Sub

Flyingdancing 发表于 2012-11-22 20:05:26

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

blackfire 发表于 2012-11-23 02:43:42

把长度导入excel自动求和

sxz4494 发表于 2016-6-3 16:52:21

你这样需要确定2点，可以只要选择多段线，就可以显示长度，或者更多的比如，选择文字，就可以把文字输入到excel呢
页: [1]
查看完整版本: 将量取的长度进行累加的求助