VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frm共性信息
Caption = "PartShip 2.0.. - 部件信息处理"
ClientHeight = 7020
ClientLeft = 30
ClientTop = 330
ClientWidth = 9885
Icon = "frm共性信息.dsx":0000
MaxButton = 0 'False
OleObjectBlob = "frm共性信息.dsx":030A
StartUpPosition = 1 '所有者中心
End
Attribute VB_Name = "frm共性信息"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''陈立晋20040701
Private Sub cbb对象类别信息_Change()
Select Case frm共性信息.cbb对象类别信息.Value
Case "主干"
frm共性信息.lbl对象名称.Caption = "主干名称"
Case "配区"
frm共性信息.lbl对象名称.Caption = "配区名称"
Case "配线"
frm共性信息.lbl对象名称.Caption = "配区名称"
Case "管道"
frm共性信息.lbl对象名称.Caption = "管道名称"
End Select
End Sub
Private Sub cbb文档编号_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim s对象名称 As String
s对象名称 = "xxxx"
If Me.cbb对象名称.Value "" Then s对象名称 = Me.cbb对象名称.Value
Select Case frm共性信息.cbb对象类别信息.Value
Case "主干"
frm共性信息.cbb文档编号.Value = "主干(" & s对象名称 & ")"
Case "配区"
frm共性信息.cbb文档编号.Value = "配区(" & s对象名称 & ")"
Case "配线"
frm共性信息.cbb文档编号.Value = "配区(" & s对象名称 & ")"
Case "管道"
frm共性信息.cbb文档编号.Value = "管道(" & s对象名称 & ")"
End Select
End Sub
Sub cmd地片示意图_Click()
' Load ufm地片划分图
' ufm地片划分图.Show
Dim Gdata, s当前目录 As String
s当前目录 = Trim(CurDir)
S网页文件名称 = "Explorer " & s当前目录 & "\Data\地片划分图.jpg"
RUNF = Shell(S网页文件名称, 1)
End Sub
Private Sub cmd扩展功能_Click()
If Me.cmd扩展功能.Caption = ">>" Then
Me.Width = 10000
Me.cmd扩展功能.Caption = " Else
Me.Width = 7000
Me.cmd扩展功能.Caption = ">>"
End If
End Sub
Private Sub cmd退出_Click()
Unload frm共性信息
End
End Sub
Private Sub cmd确定_Click()
Me.MousePointer = vbArrowHourglass
'If IsDate(frm共性信息.txt竣工日期.Text) = False _
Or IsDate(frm共性信息.txt归档日期.Text) = False _
Or IsDate(frm共性信息.txt归档日期.Text) = False _
Then MsgBox "日期型的信息必须使用正确的日期格式,例如:2001-2-18", vbInformation, "提示": Exit Sub
On Error Resume Next
If Me.cmd确定.Caption = "完成" Then Unload frm共性信息: Exit Sub
Dim s当前目录, s题图名称 As String
s当前目录 = Trim(CurDir)
s题图名称 = s当前目录 & "\Data\PDATAOUT.bmp"
Me.Img题图.Picture = LoadPicture(s题图名称)
'pPartsDCO ''
'Me.cmd确定.Caption = "完成"
'Unload frm共性信息
Me.MousePointer = 0
MsgBox "导出完成."
End Sub
Private Sub cmd应用_Click()
Call AcadToolbar.pAcadToolbar(Me.ckb默认作图板菜单)
End Sub
Private Sub UserForm_Deactivate()
End
End Sub
Private Sub UserForm_Initialize()
'On Error Resume Next ' 改变错误处理的方式。
On Error GoTo Errorhandler
Me.Width = 7000
Call AcadToolbar.pAcadToolbar(Me.ckb默认作图板菜单)
'''''''''''''''''''''''''''''''
Dim Gdata, s当前目录 As String
s当前目录 = Trim(CurDir)
'MsgBox s当前目录
Open s当前目录 & "\Data\地片.txt" For Input As #1 ' 打开输入文件。
Do While Not EOF(1) ' 循环至文件尾。
Input #1, Gdata ' 将数据读入两个变量。
cbb地片信息.AddItem Gdata ' 在立即窗口中显示数据。
Loop
Close #1 ' 关闭文件。
Open s当前目录 & "\Data\局所.txt" For Input As #1 ' 打开输入文件。
Do While Not EOF(1) ' 循环至文件尾。
Input #1, Gdata ' 将数据读入两个变量。
cbb局所信息.AddItem Gdata ' 在立即窗口中显示数据。
Loop
Close #1 ' 关闭文件。
Open s当前目录 & "\Data\机楼.txt" For Input As #1 ' 打开输入文件。
Do While Not EOF(1) ' 循环至文件尾。
Input #1, Gdata ' 将数据读入两个变量。
cbb机楼信息.AddItem Gdata ' 在立即窗口中显示数据。
Loop
Close #1 ' 关闭文件。
Open s当前目录 & "\Data\站点.txt" For Input As #1 ' 打开输入文件。
Do While Not EOF(1) ' 循环至文件尾。
Input #1, Gdata ' 将数据读入两个变量。
cbb站点信息.AddItem Gdata ' 在立即窗口中显示数据。
Loop
Close #1 ' 关闭文件。
Open s当前目录 & "\Data\对象类别.txt" For Input As #1 ' 打开输入文件。
Do While Not EOF(1) ' 循环至文件尾。
Input #1, Gdata ' 将数据读入两个变量。
cbb对象类别信息.AddItem Gdata ' 在立即窗口中显示数据。
Loop
Close #1 ' 关闭文件。
Open s当前目录 & "\Data\对象名称.txt" For Input As #1 ' 打开输入文件。
Do While Not EOF(1) ' 循环至文件尾。
Input #1, Gdata ' 将数据读入两个变量。
cbb对象名称.AddItem Gdata ' 在立即窗口中显示数据。
Loop
Close #1 ' 关闭文件。
Open s当前目录 & "\Data\建造人.txt" For Input As #1 ' 打开输入文件。
Do While Not EOF(1) ' 循环至文件尾。
Input #1, Gdata ' 将数据读入两个变量。
cbb建造人信息.AddItem Gdata ' 在立即窗口中显示数据。
Loop
Close #1 ' 关闭文件。
Exit Sub
Errorhandler:
Select Case Err
Case 76
msg = "设定数据不存在,或者'Data'子目录不存在!"
Case Else
msg = "请正确操作! 错误可能是=" & Err
End Select
MsgBox msg & ". 当前目录: " & s当前目录
'Me.tlb提示栏.Caption = "-" & msg '提示栏显示
'''''''''''''''''''''''''''''''''''''''''''''
End Sub
Private Sub tlb提示栏_Click()
Dim s命令字串 As String
'MsgBox Me.tlb提示栏.Value
If Me.tlb提示栏.Value = True Then
s命令字串 = Trim(Me.txt命令栏.Text)
Select Case s命令字串
Case ":comlong"
Me.tlb提示栏.Caption = "命令运行中..."
'ps缆线形式长度
Me.txt命令栏.Text = ":"
Me.tlb提示栏.Caption = "完成"
Me.tlb提示栏.Value = False
Case Else
Me.tlb提示栏.Caption = "???"
End Select
Else
Me.tlb提示栏.Caption = "就绪"
End If
End Sub
