📄 tsfdp.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
BackColor = &H8000000A&
Caption = "Form1"
ClientHeight = 4335
ClientLeft = 2355
ClientTop = 1665
ClientWidth = 7800
LinkTopic = "Form1"
ScaleHeight = 4335
ScaleWidth = 7800
Begin VB.CommandButton Command5
Caption = "查看表格"
Height = 375
Left = 4200
TabIndex = 6
Top = 3840
Width = 1215
End
Begin MSComDlg.CommonDialog cmDialog1
Left = 4560
Top = 2400
_ExtentX = 847
_ExtentY = 847
_Version = 393216
FileName = "c"
End
Begin VB.TextBox Text9
Height = 270
Left = 2040
TabIndex = 10
Top = 1800
Width = 3135
End
Begin VB.Frame Frame3
Caption = "输入起终点桩号"
Height = 1695
Left = 5400
TabIndex = 23
Top = 1080
Width = 2055
Begin VB.TextBox Text8
Height = 270
Left = 240
TabIndex = 3
Top = 1200
Width = 1695
End
Begin VB.TextBox Text7
Height = 270
Left = 240
TabIndex = 2
Top = 600
Width = 1695
End
Begin VB.Label Label5
Caption = "终点桩号："
Height = 255
Left = 240
TabIndex = 25
Top = 960
Width = 1095
End
Begin VB.Label Label4
Caption = "起点桩号："
Height = 255
Left = 240
TabIndex = 24
Top = 360
Width = 975
End
End
Begin MSComDlg.CommonDialog cmDialog
Left = 4320
Top = 2280
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command4
Caption = "退 出"
Height = 375
Left = 5760
TabIndex = 7
Top = 3360
Width = 1215
End
Begin VB.TextBox Text2
Height = 270
Left = 2040
TabIndex = 1
Top = 1440
Width = 3135
End
Begin VB.TextBox Text1
Height = 270
Left = 2040
TabIndex = 9
Top = 1080
Width = 3135
End
Begin VB.CommandButton Command3
Caption = "帮 助"
Height = 375
Left = 5760
TabIndex = 8
Top = 3840
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "纵向调配"
Height = 375
Left = 5760
TabIndex = 5
Top = 2880
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "生成表格"
Height = 375
Left = 4200
TabIndex = 4
Top = 2880
Width = 1215
End
Begin VB.Frame Frame2
Caption = "请输入土石方弃方比例(%)"
Height = 2055
Left = 120
TabIndex = 16
Top = 2160
Width = 3735
Begin VB.TextBox Text6
Height = 270
Left = 1320
TabIndex = 14
Top = 1440
Width = 2175
End
Begin VB.TextBox Text5
Height = 270
Left = 1320
TabIndex = 13
Top = 1080
Width = 2175
End
Begin VB.TextBox Text4
Height = 270
Left = 1320
TabIndex = 12
Top = 720
Width = 2175
End
Begin VB.TextBox Text3
Height = 270
Left = 1320
TabIndex = 11
Top = 360
Width = 2175
End
Begin VB.Label Label2
Caption = "Ⅳ级土："
Height = 255
Index = 6
Left = 480
TabIndex = 20
Top = 840
Width = 855
End
Begin VB.Label Label2
Caption = "Ⅰ～Ⅲ级土："
Height = 255
Index = 5
Left = 120
TabIndex = 19
Top = 480
Width = 1215
End
Begin VB.Label Label2
Caption = "Ⅴ级土："
Height = 255
Index = 4
Left = 480
TabIndex = 18
Top = 1200
Width = 975
End
Begin VB.Label Label2
Caption = "Ⅵ级土："
Height = 255
Index = 3
Left = 480
TabIndex = 17
Top = 1560
Width = 855
End
End
Begin VB.Frame Frame1
BackColor = &H8000000A&
Height = 855
Left = 240
TabIndex = 0
Top = 120
Width = 7095
Begin VB.Label Label1
BackColor = &H8000000A&
Caption = "路基土石方调配程序"
BeginProperty Font
Name = "宋体"
Size = 20.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1680
TabIndex = 15
Top = 240
Width = 3855
End
End
Begin VB.Label Label6
Caption = "请输入路段名称："
Height = 255
Left = 360
TabIndex = 26
Top = 1800
Width = 1575
End
Begin VB.Label Label3
Caption = "请输入工作薄名："
Height = 255
Index = 1
Left = 360
TabIndex = 22
Top = 1440
Width = 1575
End
Begin VB.Label Label3
Caption = "路线数据所在目录："
Height = 255
Index = 0
Left = 360
TabIndex = 21
Top = 1080
Width = 2415
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents xlbook1 As Excel.Workbook
Attribute xlbook1.VB_VarHelpID = -1
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hWnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub Command1_Click() '生成表格按钮所做的反映
Dim yn As Integer, yn1 As Integer
qdzh = 0: zdzh = 0
filename1 = CStr(Text1.Text)
ldmc = Text9.Text
qt1_3 = Val(Text3.Text) / 100
qt4 = Val(Text4.Text) / 100
qt5 = Val(Text5.Text) / 100
qt6 = Val(Text6.Text) / 100
bg = CStr(Text2.Text)
If bg = "" Then
MsgBox ("输入工作薄名。")
ElseIf sgzb = 1 Then
yn1 = 1
MsgBox ("与现有的工作薄重名，请重新输入。")
Else
yn1 = 0
End If
If Text7.Text = "" Or Text8.Text = "" Then
yn = 1
MsgBox ("输入起终点桩号。")
ElseIf CDbl(Text7.Text) - CDbl(Text8.Text) > 0 Then
yn = 1
MsgBox ("终点桩号比起点桩号大，请重新输入。")
Else
yn = 0
End If
If yn = 0 And yn1 = 0 Then
qdzh = Val(Text7.Text)
zdzh = Val(Text8.Text)
Set xlbook1 = xlbook
xlbook1.Windows(1).Visible = True
copy_bg1
tfb
End If
End Sub
Private Sub Command4_Click() '退出按钮所做的动作
Unload Me
End Sub
Private Sub Command5_Click() '查看表格按钮所做的动作
ckbg
End Sub
Private Sub Form_Load()
Text1 = ReadOneString("Option", "Text1") '写入上次文本框中的内容，以下同
Text9 = ReadOneString("Option", "Text9")
Text3 = ReadOneString("Option", "Text3")
Text4 = ReadOneString("Option", "Text4")
Text5 = ReadOneString("Option", "Text5")
Text6 = ReadOneString("Option", "Text6")
iniExcel '引用Excel
End Sub
Private Sub Form_Unload(Cancel As Integer)
Text1 = WriteOneString("Option", "Text1", Text1) '保存文本框的内容，以下同
Text9 = WriteOneString("Option", "Text9", Text9)
Text3 = WriteOneString("Option", "Text3", Text3)
Text4 = WriteOneString("Option", "Text4", Text4)
Text5 = WriteOneString("Option", "Text5", Text5)
Text6 = WriteOneString("Option", "Text6", Text6)
If xlbook.Application.Visible = False Then
xlbook1.Application.Visible = True
xlbook1.Windows(1).Visible = True
xlbook1.Application.WindowState = xlMinimized
End If
Set xlbook1 = Nothing
Qquit_Excel
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) '用回车键模拟“Tab”键
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub Text8_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub Text9_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub xlbook1_BeforeClose(Cancel As Boolean)
MsgBox ("不能在这里退出Excel，请使用“退出”按钮")
Cancel = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -