明总在你的指导下我已把程式做好,请你指正,再一次感谢你.其它朋友也可来参考一个

jxb8888

Private Sub CommandButton1_Click()
If Trim(TextBox2.Text) = "0" Then
MsgBox "没定义图号", vbOKOnly
Me.Hide
Exit Sub
End If
If Trim(TextBox13.Text) = "" Then
MsgBox "没定义图纸位置", vbOKOnly
Exit Sub
End If
Adodc1.RecordSource = "select * from dwgno where 图号='" + Trim(TextBox2.Text) + "' "
Adodc1.Refresh
If Adodc1.Recordset.RecordCount <> 0 Then
MsgBox "有重复记录，要覆盖性写入数据吗?", vbYesNo
Adodc1.Recordset!客户名称 = Trim(TextBox1.Text)
Adodc1.Recordset!图号 = Trim(TextBox2.Text)
Adodc1.Recordset!型号 = Trim(TextBox3.Text)
Adodc1.Recordset!单重 = Trim(TextBox5.Text)
Adodc1.Recordset!外周长 = Trim(TextBox6.Text)
Adodc1.Recordset!打胶面积 = Trim(TextBox8.Text)
Adodc1.Recordset!日期 = Trim(TextBox9.Text)
Adodc1.Recordset!图纸位置 = Trim(TextBox13.Text)
Adodc1.Recordset.Update
CommandButton1.SetFocus
Adodc1.Recordset.MoveLast
Else
Adodc1.Recordset.AddNew
Adodc1.Recordset!客户名称 = Trim(TextBox1.Text)
Adodc1.Recordset!图号 = Trim(TextBox2.Text)
Adodc1.Recordset!型号 = Trim(TextBox3.Text)

Adodc1.Recordset!单重 = Trim(TextBox5.Text)
Adodc1.Recordset!外周长 = Trim(TextBox6.Text)
Adodc1.Recordset!打胶面积 = Trim(TextBox8.Text)
Adodc1.Recordset!日期 = Trim(TextBox9.Text)
Adodc1.Recordset!图纸位置 = Trim(TextBox13.Text)
Adodc1.Recordset.Update
CommandButton1.SetFocus
Adodc1.Recordset.MoveLast
End If
DataGrid1.Columns(0).Width = 50
  DataGrid1.Columns(1).Width = 60
  DataGrid1.Columns(2).Width = 50
  DataGrid1.Columns(3).Width = 50
  DataGrid1.Columns(4).Width = 50
  DataGrid1.Columns(5).Width = 50
  DataGrid1.Columns(6).Width = 50
  DataGrid1.Columns(7).Width = 50
  DataGrid1.Columns(8).Width = 50
  DataGrid1.Columns(9).Width = 50
  DataGrid1.Columns(10).Width = 160
End Sub
Public Function StrSub(ByVal src As String, ParamArray dst()) As String
Dim i As Long
Dim j As Long
Dim l1 As Long
Dim l2 As Long
Dim src1 As String
Dim src2 As String
For i = 0 To UBound(dst)
l1 = Len(src)
l2 = Len(dst(i))
j = InStr(src, dst(i))
If j = 0 Then
i = i + 1
GoTo top
End If
src1 = Left(src, j - 1)
src2 = Right(src, l1 - j - l2 + 1)
src = src1 + src2
top:
Next
StrSub = src
End Function
Private Sub UserForm_Activate()
'要使用DataGrid控件，必须首先要有一个数据源，可以使用Adodc控件来与数据库连接。
Adodc1.ConnectionString = "rovider=Microsoft.Jet.OLEDB.4.0;Data Source=I:\JXB-file\my love\cad\dwgno.mdb"
Adodc1.RecordSource = "dwgno"
Set DataGrid1.DataSource = Adodc1 '设置DataGrid的数据源为Adodc
DataGrid1.Refresh '更新
'增加记录可以使用Adodc1.Recordset.AddNew来添加一条记录，之后使用Adodc1.Recordset.Update来保存记录。
'--------------------------------------------------------------
  DataGrid1.Columns(0).Width = 50
  DataGrid1.Columns(1).Width = 60
  DataGrid1.Columns(2).Width = 50
  DataGrid1.Columns(3).Width = 50
  DataGrid1.Columns(4).Width = 50
  DataGrid1.Columns(5).Width = 50
  DataGrid1.Columns(6).Width = 50
  DataGrid1.Columns(7).Width = 50
  DataGrid1.Columns(8).Width = 50
  DataGrid1.Columns(9).Width = 50
  DataGrid1.Columns(10).Width = 160

'把图纸中的数据取出放到窗体中的文本框中
'客户名称''''''''''
Dim khObj As AcadText
Set khObj = ThisDrawing.HandleToObject("9B8")
TextBox1.Text = Trim(khObj.textString)
'图号'''''''''''
Dim thobj As AcadText
Set thobj = ThisDrawing.HandleToObject("9B9")
TextBox2.Text = Trim(thobj.textString)
'型号'''''''''''
Dim xhobj As AcadText
Set xhobj = ThisDrawing.HandleToObject("9BA")
TextBox3.Text = Trim(xhobj.textString)
'''''单重''''''''
Dim dzobj As AcadText
Set dzobj = ThisDrawing.HandleToObject("c4a")
TextBox5.Text = Trim(dzobj.textString)
''''周长'''''''
Dim zcobj As AcadText
Set zcobj = ThisDrawing.HandleToObject("c63")
TextBox6.Text = Trim(zcobj.textString)
'''''打胶面积'''''''
Dim djobj As AcadText
Set djobj = ThisDrawing.HandleToObject("9c1")
TextBox8.Text = Trim(djobj.textString)
''''''''''日期'''''''''
Dim rqobj As AcadText
Set rqobj = ThisDrawing.HandleToObject("c58")
TextBox9.Text = Trim(rqobj.textString)
'''图纸位置''
Dim a0 As String
Dim a1, a2, a3 As String
AutoRedraw = True
a0 = ThisDrawing.Application.Caption
a1 = "AutoCAD 2004 - ["
a2 = " "
a3 = "]"
TextBox13.Text = StrSub(a0, a1, a2, a3)

'''命令按钮1获得TAB点
CommandButton1.SetFocus
End Sub

mccad

最好能把程序上传，因为你带有对话框。
看你的程序内容，好象跟AutoCAd没有什么关系，只是利用了VBA来做数据库输入。