📄 数据文件_录入f2.frm
字号:
VERSION 5.00
Begin VB.Form frmArray
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "在空白窗格内录入数据"
ClientHeight = 8370
ClientLeft = 60
ClientTop = 345
ClientWidth = 12750
LinkTopic = "Form1"
ScaleHeight = 8370
ScaleWidth = 12750
Begin VB.CommandButton cmdExit
Caption = "退出"
Height = 255
Left = 1440
TabIndex = 5
TabStop = 0 'False
ToolTipText = "结束程序运行"
Top = 0
Width = 735
End
Begin VB.CommandButton cmdPrint
Caption = "打印"
Height = 255
Left = 720
TabIndex = 4
TabStop = 0 'False
ToolTipText = "打印机打印录入数据"
Top = 0
Width = 735
End
Begin VB.CommandButton cmdSave
Caption = "保存"
Height = 255
Left = 0
TabIndex = 2
TabStop = 0 'False
ToolTipText = "将录入数据保存到数据文件"
Top = 0
Width = 855
End
Begin VB.TextBox txtInput
Appearance = 0 'Flat
Height = 270
Index = 0
Left = 720
TabIndex = 0
Top = 480
Width = 735
End
Begin VB.Label lblCol
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 720
TabIndex = 3
Top = 240
Width = 735
End
Begin VB.Label lblRow
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 0
TabIndex = 1
Top = 480
Width = 735
End
End
Attribute VB_Name = "frmArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'文本框数组录入窗体
Option Explicit
Dim sngtxtHig As Single, sngtxtWid As Single
Dim snglblHig As Single, snglblWid As Single
Dim intI As Integer, intJ As Integer
Private Sub Form_Load()
Dim intRowStart As Integer
'使设计时安置在窗体的原型控件不可见
txtInput(0).Visible = False
lblRow(0).Visible = False
lblCol(0).Visible = False
'利用原型控件的坐标参数
sngtxtHig = txtInput(0).Height
sngtxtWid = txtInput(0).Width
snglblHig = sngtxtHig
snglblWid = sngtxtWid
'形成文本框数组
For intI = 1 To intRowAll
For intJ = 1 To intCol
Load txtInput((intI - 1) * intCol + intJ)
txtInput((intI - 1) * intCol + intJ).Move _
txtInput(0).Left + (intJ - 1) * sngtxtWid, _
txtInput(0).Top + (intI - 1) * sngtxtHig
txtInput((intI - 1) * intCol + intJ).Visible = True
txtInput((intI - 1) * intCol + intJ).Text = ""
Next intJ
Next intI
intRowStart = 1
'形成左边标签框，对行作标记
'第1行保存列数
Load lblRow(intRowStart)
lblRow(intRowStart).Move lblRow(0).Left, _
lblRow(0).Top + (intRowStart - 1) * snglblHig
lblRow(intRowStart).Visible = True
lblRow(intRowStart).Caption = "列数"
txtInput(1).Text = intCol '列数
If intCol >= 2 Then
For intJ = 2 To intCol
'行数只放在第1列。其余的列充以*******，表示这些列没有用
txtInput((intRowStart - 1) * intCol + intJ).Text = "*******"
Next intJ
End If
intRowStart = 2
'第2行保存行数
Load lblRow(intRowStart)
lblRow(intRowStart).Move lblRow(0).Left, _
lblRow(0).Top + (intRowStart - 1) * snglblHig
lblRow(intRowStart).Visible = True
lblRow(intRowStart).Caption = "行数"
txtInput((intRowStart - 1) * intCol + 1).Text = intRow '行数
If intCol >= 2 Then
For intJ = 2 To intCol
'行数只放在第1列。其余的列充以*******，表示这些列没有用
txtInput((intRowStart - 1) * intCol + intJ).Text = "*******"
Next intJ
End If
intRowStart = 3
'第3行保存总行数
Load lblRow(intRowStart)
lblRow(intRowStart).Move lblRow(0).Left, _
lblRow(0).Top + (intRowStart - 1) * snglblHig
lblRow(intRowStart).Visible = True
lblRow(intRowStart).Caption = "总行数"
txtInput((intRowStart - 1) * intCol + 1).Text = intRowAll '总行数
If intCol >= 2 Then
For intJ = 2 To intCol
'行数只放在第1列。其余的列充以*******，表示这些列没有用
txtInput((intRowStart - 1) * intCol + intJ).Text = "*******"
Next intJ
End If
intRowStart = 4
If blnTitle Then '形成标题标记
Load lblRow(intRowStart)
lblRow(intRowStart).Move lblRow(0).Left, _
lblRow(0).Top + (intRowStart - 1) * snglblHig
lblRow(intRowStart).Visible = True
lblRow(intRowStart).Caption = "标题"
If intCol >= 2 Then
For intJ = 2 To intCol
'标题只放在第1列。其余的列充以*******，表示这些列没有用
txtInput((intRowStart - 1) * intCol + intJ).Text = "*******"
Next intJ
End If
intRowStart = 5
End If
If blnRowLabel Then '形成行标记
For intI = intRowStart To (intRowStart + intRow - 1)
Load lblRow(intI)
lblRow(intI).Move lblRow(0).Left, _
lblRow(0).Top + (intI - 1) * snglblHig
lblRow(intI).Visible = True
lblRow(intI).Caption = "行标" & (intI - intRowStart + 1)
If intCol >= 2 Then
For intJ = 2 To intCol
'行标只放在第1列。其余的列充以*******，表示这些列没有用
txtInput((intI - 1) * intCol + intJ).Text = "*******"
Next intJ
End If
Next intI
intRowStart = intRowStart + intRow
End If
If blnColLabel Then '形成列标记
Load lblRow(intRowStart)
lblRow(intRowStart).Move lblRow(0).Left, _
lblRow(0).Top + (intRowStart - 1) * snglblHig
lblRow(intRowStart).Visible = True
lblRow(intRowStart).Caption = "列标"
intRowStart = intRowStart + 1
End If
For intI = intRowStart To intRowAll '数据行的标记
Load lblRow(intI)
lblRow(intI).Move lblRow(0).Left, _
lblRow(0).Top + (intI - 1) * snglblHig
lblRow(intI).Visible = True
lblRow(intI).Caption = "第" & (intI - intRowStart + 1) & "行"
Next intI
'形成上边标签框，对列作标记
For intI = 1 To intCol
Load lblCol(intI)
lblCol(intI).Move lblCol(0).Left + (intI - 1) * snglblWid, _
lblCol(0).Top
lblCol(intI).Visible = True
lblCol(intI).Caption = "第" & intI & "列"
Next intI
End Sub
'打印
Private Sub cmdPrint_Click()
Dim intI1 As Integer, intI2 As Integer
intI1 = 1: intI2 = 8
If intCol <= 8 Then intI2 = intCol
AA1:
Printer.Print ,
For intI = intI1 To intI2
Printer.Print lblCol(intI).Caption, '打印列标记
Next intI
For intI = 1 To intRowAll
Printer.Print
Printer.Print lblRow(intI), '打印行标记
For intJ = intI1 To intI2
'打印数据
Printer.Print txtInput((intI - 1) * intCol + intJ).Text,
Next intJ
Next intI
If intCol > 8 And intI2 <= 8 Then
intI1 = intI1 + 8
intI2 = intCol
Printer.Print
Printer.Print
GoTo AA1
End If
Printer.EndDoc '执行打印
End Sub
'形成数组并保存为数据文件
Private Sub cmdSave_Click()
Dim intFileNumber As Integer
Dim vntA As Variant
MsgBox "开始保存数据，请耐心等待！"
intFileNumber = FreeFile '取得空闲的文件号
Open strFileName For Output As intFileNumber '打开文件
For intI = 1 To intRowAll
For intJ = 1 To intCol
'将数组中的数据写到文件上
Write #intFileNumber, txtInput((intI - 1) * intCol + intJ);
Next intJ
Next intI
'将上部的标签内容写到文件
For intI = 1 To intCol
Write #intFileNumber, lblCol(intI).Caption
Next intI
'将左边的标签内容写到文件
For intI = 1 To intRowAll
Write #intFileNumber, lblRow(intI).Caption
Next intI
Close '关闭文件
cmdSave.Visible = False
MsgBox "保存数据完成，请继续进行！"
End Sub
'退出
Private Sub cmdExit_Click()
Unload Me
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -