Public table As String
Public flag As Integer
Public picname As String
Public outpath As String
Private Sub command1_Click()
On Error Resume Next
Dim tb As String, fl As String, filename As String
Dim i As Integer
Dim infotable As String
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sqlstr As String
tb = ""
fl = ""
filename = ""
If flag >= 1 And flag <= 4 Then
tb = "盘套类零件尺寸信息"
If flag = 1 Then
fl = "端盖"
filename = "端盖.jpg"
ElseIf flag = 2 Then
fl = "支撑套筒"
filename = "支撑套筒.jpg"
ElseIf flag = 3 Then
fl = "轴承套"
filename = "轴承套.jpg"
ElseIf flag = 4 Then
fl = "偏心套"
filename = "偏心套.jpg"
End If
ElseIf flag >= 5 And flag <= 7 Then
tb = "箱体零件尺寸信息"
If flag = 5 Then
fl = "尾架壳体"
filename = "尾架壳体.jpg"
ElseIf flag = 6 Then
fl = "主轴箱壳体"
filename = "主轴箱壳体.jpg"
Else
fl = "变速箱壳体"
filename = "变速箱壳体.jpg"
End If
ElseIf flag >= 8 And flag <= 11 Then
tb = "轴类零件尺寸信息"
If flag = 8 Then
fl = "小轴"
filename = "小轴.jpg"
ElseIf flag = 9 Then
fl = "曲轴"
filename = "曲轴.jpg"
ElseIf flag = 10 Then
fl = "花键轴"
filename = "花键轴.jpg"
Else
fl = "传动轴"
filename = "传动轴.jpg"
End If
End If
If tb <> "" And fl <> "" Then
sqlstr = "select * from " & tb & " where 名称='" & fl & "'"
' MsgBox tb, vbInformation, fl
con.Open database
rs.Open sqlstr, con, 1, 1
If Not rs.EOF Then
Set wd = CreateObject("word.Application")
wd.Documents.Open filename:=App.Path & "\lx.Dot", ConfirmConversions:=False, ReadOnly:= _
False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
"", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto
wd.Selection.Find.ClearFormatting
wd.Selection.Find.Replacement.ClearFormatting
With wd.Selection.Find '替换标题
.Text = "[cpmc]"
.Replacement.Text = fl
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wd.Selection.Find.Execute Replace:=wdReplaceAll
wd.Selection.Find.ClearFormatting
wd.Selection.Find.Replacement.ClearFormatting
With wd.Selection.Find '替换零件名称
.Text = "[ljmc]"
.Replacement.Text = fl
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wd.Selection.Find.Execute Replace:=wdReplaceAll
wd.Selection.Find.ClearFormatting
wd.Selection.Find.Replacement.ClearFormatting
With wd.Selection.Find '替换材料牌号
.Text = "[clph]"
.Replacement.Text = Trim(rs(1).Value)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wd.Selection.Find.Execute Replace:=wdReplaceAll
wd.Selection.Find.ClearFormatting
wd.Selection.Find.Replacement.ClearFormatting
With wd.Selection.Find '替换毛胚种类
.Text = "[mpzl]"
.Replacement.Text = Trim(rs(2).Value)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wd.Selection.Find.Execute Replace:=wdReplaceAll
wd.Selection.Find.ClearFormatting
wd.Selection.Find.Replacement.ClearFormatting
With wd.Selection.Find '替换毛丕外形尺寸
.Text = "[wxcc]"
.Replacement.Text = Trim(rs(3).Value)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wd.Selection.Find.Execute Replace:=wdReplaceAll
wd.Selection.MoveDown unit:=wdLine, Count:=6
wd.Selection.MoveLeft unit:=wdCharacter, Count:=2
Adodc1.Recordset.MoveFirst
Do While Not Adodc1.Recordset.EOF
For i = 0 To 7
'wd.Selection.MoveLeft unit:=wdCharacter, Count:=5
wd.Selection.TypeText Text:=CStr(Trim(Adodc1.Recordset.Fields(i).Value))
wd.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wd.Selection.MoveRight unit:=wdCharacter, Count:=1
Next i
Adodc1.Recordset.MoveNext
If Not Adodc1.Recordset.EOF Then
wd.Selection.InsertRowsBelow 1 ''''添加一行
wd.Selection.MoveLeft unit:=wdCharacter, Count:=2
End If
Loop
wd.Selection.MoveRight unit:=wdCharacter, Count:=3
If flag <> -1 Then
wd.Selection.InlineShapes.AddPicture filename:=App.Path & "\pic\" & filename, _
LinkToFile:=False, SaveWithDocument:=True
End If
wd.ActiveWindow.ActivePane.VerticalPercentScrolled = 0
If flag = -1 Then
table = table & "_" & fl
End If
wd.ActiveDocument.SaveAs filename:=outpath & table & ".doc", FileFormat:= _
wdFormatTemplate, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
wd.Quit
Set wd = Nothing
End If
rs.Close
Set rs = Nothing
Set con = Nothing
End If
End Sub
Private Sub command2_Click()
On Error GoTo herr
picpath = App.Path & "\pic\" & picname
Form3.picture1.Picture = LoadPicture(picpath)
Form3.Show , Me
Exit Sub
herr:
End Sub
Private Sub Command3_Click()
Dim p As String
dg1.InitDir = outpath
dg1.ShowOpen
p = dg1.filename
outpath = getpath(p)
Text1.Text = outpath
End Sub
Private Function getpath(s As String) As String
Dim i As Integer, n As Integer
s = Trim(s)
n = Len(s)
For i = n To 1 Step -1
If Right(Left(s, i), 1) = "\" Then
getpath = Left(s, i)
Exit Function
End If
Next
getpath = ""
End Function
Private Sub Form_Load()
database = "driver={microsoft access driver (*.mdb)};dbq=" & App.Path & "\lx.mdb;"
Command1.Enabled = False
flag = 0
Adodc1.ConnectionString = database
table = ""
outpath = "c:\"
Text1.Text = outpath
App.HelpFile = App.Path + "\典型零件的CAPP.hlp"
End Sub
Private Sub dbconn()
Label1.Caption = table
Adodc1.RecordSource = "select * from " & table
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
If Adodc1.Recordset.RecordCount = 0 Then
Command1.Enabled = False
Else
Command1.Enabled = True
End If
End Sub
Private Sub lx42_Click()
Form5.Show , Me
End Sub
Private Sub lx41_Click()
Const HelpCNT = &HB
With CommonDialog1
'必须设置 Help 文件名。
.HelpFile = App.Path & "\典型零件的CAPP.HLP"
'显示目录。注意 HelpCNT 常数不是一个内部常数。
'cdlHelpSetContents确保了只显示目录
'(而不显示索引或查找)。
.HelpCommand = HelpCNT Or cdlHelpSetContents
.ShowHelp
End With
End Sub
Private Sub lx11_Click()
table = "小轴的机械加工工艺过程"
flag = 8
picname = "小轴.jpg"
dbconn
End Sub
Private Sub lx12_Click()
table = "曲轴的机械加工工艺过程"
flag = 9
picname = "曲轴.jpg"
dbconn
End Sub
Private Sub lx13_Click()
table = "花键轴的机械加工工艺过程"
flag = 10
picname = "花键轴.jpg"
dbconn
End Sub
Private Sub lx14_Click()
table = "传动轴的机械加工工艺过程"
flag = 11
picname = "传动轴.jpg"
dbconn
End Sub
Private Sub lx21_Click()
table = "端盖的机械加工工艺过程"
flag = 1
picname = "端盖.jpg"
dbconn
End Sub
Private Sub lx22_Click()
table = "轴承套的机械加工工艺过程"
flag = 3
picname = "轴承套.jpg"
dbconn
End Sub
Private Sub lx23_Click()
table = "偏心套的机械加工工艺过程"
flag = 4
picname = "偏心套.jpg"
dbconn
End Sub
Private Sub lx24_Click()
table = "支撑轴套的机械加工工艺过程"
flag = 2
picname = "支撑轴套.jpg"
dbconn
End Sub
Private Sub lx31_Click()
table = "尾架壳体的机械加工工艺过程"
flag = 5
picname = "尾架壳体.jpg"
dbconn
End Sub
Private Sub lx32_Click()
table = "主轴箱壳体的机械加工工艺过程"
flag = 6
picname = "主轴箱壳体.jpg"
dbconn
End Sub
Private Sub lx33_Click()
table = "变速箱壳体的机械加工工艺过程"
flag = 7
picname = "变速箱壳体.jpg"
dbconn
End Sub
'检查列表中是否存在
Private Function checkexist(sname As String) As Boolean
Dim i As Integer, n As Integer, subs As String
With Combo1
n = .ListCount
For i = 0 To n - 1
subs = .List(i)
If subs = sname Then
checkexist = True
Exit Function
End If
Next
End With
checkexist = False
End Function
Private Function getlei(s As String) As String
Dim i As Integer, n As Integer
Dim lei As String
s = Trim(s)
n = Len(s)
For i = 1 To n
If Right(Left(s, i), 1) = "_" Then
lei = Right(s, n - i)
getlei = lei
Exit Function
End If
Next
lei = ""
End Function
