📄 oldoption.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form oldoption
BorderStyle = 3 'Fixed Dialog
Caption = "LS表格选择"
ClientHeight = 3285
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 5595
Icon = "oldoption.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3285
ScaleWidth = 5595
ShowInTaskbar = 0 'False
Begin VB.Timer Timer1
Interval = 500
Left = 1200
Top = 2760
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 240
Top = 2760
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.OptionButton Option3
Caption = "LS图样目录(TM)"
Height = 495
Left = 600
TabIndex = 4
Top = 1440
Width = 2895
End
Begin VB.OptionButton Option2
Caption = "LS采购清单(GX)"
Height = 375
Left = 600
TabIndex = 3
Top = 960
Width = 2535
End
Begin VB.OptionButton Option1
Caption = "LS明细表(MX)"
Height = 375
Left = 600
TabIndex = 2
Top = 480
Width = 2535
End
Begin VB.CommandButton CancelButton
Caption = "取消"
Height = 375
Left = 4200
TabIndex = 1
Top = 2760
Width = 1215
End
Begin VB.CommandButton OKButton
Caption = "确定"
Height = 375
Left = 2640
TabIndex = 0
Top = 2760
Width = 1215
End
Begin VB.Frame Frame1
Caption = "选择表格(OLD)"
Height = 2055
Left = 240
TabIndex = 5
Top = 120
Width = 5175
End
Begin VB.Label spark
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 3240
TabIndex = 7
Top = 2280
Width = 1335
End
Begin VB.Label warninglable
Caption = "注意: 以上内容将被导入机型 "
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 360
TabIndex = 6
Top = 2280
Width = 2895
End
End
Attribute VB_Name = "oldoption"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim xlsinfile As String
Dim rsintable As New ADODB.Recordset
Dim CNexcel As New ADODB.Connection
Dim RSexcel As New ADODB.Recordset
Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub
Private Sub CancelButton_Click()
tableoption = 0
Unload Me
主菜单.mainGrid.Clear
主菜单.mainGrid.Visible = False
End Sub
Private Sub Form_Load()
MakeCenter oldoption
tableoption = 0
spark.Caption = savetablename
End Sub
Private Sub Option1_Click()
tableoption = 1
End Sub
Private Sub Option2_Click()
tableoption = 2
End Sub
Private Sub Option3_Click()
tableoption = 3
End Sub
Private Sub okButton_Click()
Dim tablename As String
If tableoption = 0 Then
MsgBox "您尚未选择导入文件格式!", vbInformation, "EXCEL导入"
Exit Sub
End If
CommonDialog1.CancelError = True
On Error GoTo errdeal
CommonDialog1.CancelError = True
CommonDialog1.DialogTitle = "从LS表格式excel导入数据"
CommonDialog1.FileName = "*.xls"
CommonDialog1.Filter = "(xls格式)*.xls|*.xls"
CommonDialog1.ShowOpen
xlsinfile = CommonDialog1.FileName
'OLE DB + ODBC Driver 方式:
'adoConnection.Open "Data Provider=MSDASQL.1;driver=Microsoft Excel Driver (*.xls);DBQ=e:\temp\book2.xls"
'Microsoft.Jet.OLEDB.4.0 方式,(建议)
With CNexcel
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Persist Security Info=False;" & _
"Data Source=" & xlsinfile & ";" & _
"Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
.open
End With
RSexcel.open "select * from [sheet1$]", CNexcel, adOpenKeyset, adLockOptimistic
If RSexcel.EOF = True Then '判断是否为空
MsgBox "该excel表格为空白表！", vbInformation, "提醒"
tableoption = 0
Exit Sub
End If
Select Case tableoption
Case 0
MsgBox "您尚未选择导入文件格式!", vbInformation, "EXCEL导入"
Case 1
Call mxbtablein
Case 2
Call caigoutablein
Case 3
Call tuyangtablein
End Select
主菜单.tableinbar.Buttons("save").Enabled = True
Unload Me
RSexcel.Close
CNexcel.Close
Exit Sub
errdeal:
'
tableoption = 0
Exit Sub
End Sub
Private Sub mxbtablein()
主菜单.mainStatusBar.Panels(2).Text = "导入行数: " + Trim(RSexcel.RecordCount)
主菜单.mainGrid.Visible = True
Set 主菜单.mainGrid.DataSource = RSexcel
Call MXShowGrid(RSexcel, 主菜单.mainGrid)
End Sub
Public Sub MXShowGrid(ByVal Recordset As ADODB.Recordset, ByVal flexGrid As MSHFlexGrid)
Dim i As Integer
Dim j As Integer
With flexGrid
.SelectionMode = flexSelectionByRow
.ScrollBars = flexScrollBarBoth
.FillStyle = flexFillSingle
.ScrollTrack = True
.AllowUserResizing = flexResizeColumns
.ColWidth(0) = 5
.ColWidth(1) = 800
.ColWidth(2) = 1800
.ColWidth(3) = 2500
.ColWidth(4) = 2000
.ColWidth(5) = 3000
.ColWidth(6) = 800
.ColWidth(7) = 1000
.ColAlignmentFixed(1) = 4
.ColAlignmentFixed(2) = 4 '设置表格标题的对齐方式
.ColAlignmentFixed(3) = 4
.ColAlignmentFixed(4) = 4
.ColAlignmentFixed(5) = 4
.ColAlignmentFixed(6) = 4
.ColAlignmentFixed(7) = 4
.ColAlignment(1) = 4 '设置表格内容的对齐方式
.ColAlignment(2) = 2
.ColAlignment(3) = 2
.ColAlignment(4) = 2
.ColAlignment(5) = 2
.ColAlignment(6) = 4
.ColAlignment(7) = 4
End With
For i = 1 To flexGrid.Rows - 1
flexGrid.Row = i
For j = 1 To flexGrid.Cols - 1
flexGrid.Col = j
If (flexGrid.Row Mod 2) = 0 Then
flexGrid.CellBackColor = &HE0E0E0
Else
flexGrid.CellBackColor = vbWhite
End If
Next j
Next i
End Sub
Private Sub caigoutablein()
主菜单.mainStatusBar.Panels(2).Text = "导入行数: " + Trim(RSexcel.RecordCount)
主菜单.mainGrid.Visible = True
Set 主菜单.mainGrid.DataSource = RSexcel
Call GXShowGrid(RSexcel, 主菜单.mainGrid)
End Sub
Public Sub GXShowGrid(ByVal Recordset As ADODB.Recordset, ByVal flexGrid As MSHFlexGrid)
Dim i As Integer
Dim j As Integer
With flexGrid
.SelectionMode = flexSelectionByRow
.ScrollBars = flexScrollBarBoth
.FillStyle = flexFillSingle
.ScrollTrack = True
.AllowUserResizing = flexResizeColumns
.ColWidth(0) = 5
.ColWidth(1) = 800
.ColWidth(2) = 1800
.ColWidth(3) = 2500
.ColWidth(4) = 2000
.ColWidth(5) = 3000
.ColWidth(6) = 800
.ColWidth(7) = 1000
.ColAlignmentFixed(1) = 4
.ColAlignmentFixed(2) = 4 '设置表格标题的对齐方式
.ColAlignmentFixed(3) = 4
.ColAlignmentFixed(4) = 4
.ColAlignmentFixed(5) = 4
.ColAlignmentFixed(6) = 4
.ColAlignmentFixed(7) = 4
.ColAlignment(1) = 4 '设置表格内容的对齐方式
.ColAlignment(2) = 2
.ColAlignment(3) = 2
.ColAlignment(4) = 2
.ColAlignment(5) = 2
.ColAlignment(6) = 4
.ColAlignment(7) = 4
End With
For i = 1 To flexGrid.Rows - 1
flexGrid.Row = i
For j = 1 To flexGrid.Cols - 1
flexGrid.Col = j
If (flexGrid.Row Mod 2) = 0 Then
flexGrid.CellBackColor = &HE0E0E0
Else
flexGrid.CellBackColor = vbWhite
End If
Next j
Next i
End Sub
Private Sub tuyangtablein()
主菜单.mainStatusBar.Panels(2).Text = "导入行数: " + Trim(RSexcel.RecordCount)
主菜单.mainGrid.Visible = True
Set 主菜单.mainGrid.DataSource = RSexcel
Call TMShowGrid(RSexcel, 主菜单.mainGrid)
End Sub
Public Sub TMShowGrid(ByVal Recordset As ADODB.Recordset, ByVal flexGrid As MSHFlexGrid)
Dim i As Integer
Dim j As Integer
With flexGrid
.SelectionMode = flexSelectionByRow
.ScrollBars = flexScrollBarBoth
.FillStyle = flexFillSingle
.ScrollTrack = True
.AllowUserResizing = flexResizeColumns
.ColWidth(0) = 5
.ColWidth(1) = 800
.ColWidth(2) = 800
.ColWidth(3) = 1800
.ColWidth(4) = 2500
.ColWidth(5) = 800
.ColWidth(6) = 800
.ColWidth(7) = 1000
.ColAlignmentFixed(1) = 4
.ColAlignmentFixed(2) = 4 '设置表格标题的对齐方式
.ColAlignmentFixed(3) = 4
.ColAlignmentFixed(4) = 4
.ColAlignmentFixed(5) = 4
.ColAlignmentFixed(6) = 4
.ColAlignmentFixed(7) = 4
.ColAlignment(1) = 4 '设置表格内容的对齐方式
.ColAlignment(2) = 4
.ColAlignment(3) = 2
.ColAlignment(4) = 2
.ColAlignment(5) = 2
.ColAlignment(6) = 4
.ColAlignment(7) = 4
End With
For i = 1 To flexGrid.Rows - 1
flexGrid.Row = i
For j = 1 To flexGrid.Cols - 1
flexGrid.Col = j
If (flexGrid.Row Mod 2) = 0 Then
flexGrid.CellBackColor = &HE0E0E0
Else
flexGrid.CellBackColor = vbWhite
End If
Next j
Next i
End Sub
Private Sub Timer1_Timer()
'警告闪烁功能
If spark.Visible = False Then
spark.Visible = True
Else
spark.Visible = False
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -