📄 trans.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form trans
BackColor = &H00D7F9EA&
Caption = "商品采购凭证导入"
ClientHeight = 6270
ClientLeft = 60
ClientTop = 345
ClientWidth = 11085
Icon = "trans.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6270
ScaleWidth = 11085
StartUpPosition = 2 '屏幕中心
Begin MSFlexGridLib.MSFlexGrid flggrid
Height = 4215
Left = 240
TabIndex = 2
Top = 720
Width = 10575
_ExtentX = 18653
_ExtentY = 7435
_Version = 393216
Rows = 4
Cols = 10
FixedRows = 2
FixedCols = 0
BackColorBkg = 16777215
AllowUserResizing= 1
End
Begin MSComctlLib.ProgressBar ProgressBar1
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 1
Top = 6015
Width = 11085
_ExtentX = 19553
_ExtentY = 450
_Version = 393216
Appearance = 1
End
Begin MSComDlg.CommonDialog cd1
Left = 720
Top = 480
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 420
Left = 0
TabIndex = 0
Top = 0
Width = 11085
_ExtentX = 19553
_ExtentY = 741
ButtonWidth = 4048
ButtonHeight = 582
ToolTips = 0 'False
AllowCustomize = 0 'False
Wrappable = 0 'False
Appearance = 1
TextAlignment = 1
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 4
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "导入（商品大类） "
Key = "import"
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "导入（供应商） "
Key = "import2"
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "生成凭证txt文件 "
Key = "build"
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出 "
Key = "exit"
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ImageList1
Left = 9480
Top = 5280
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 20
ImageHeight = 20
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "trans.frx":0BC2
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "trans.frx":0CAB
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "trans.frx":0E05
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "trans.frx":1557
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "trans.frx":1905
Key = ""
EndProperty
EndProperty
End
Begin VB.Label zhu
AutoSize = -1 'True
BackColor = &H00D7F9EA&
Caption = "注："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 210
Left = 120
TabIndex = 5
Top = 5400
Width = 420
End
Begin VB.Label zhu1
AutoSize = -1 'True
BackColor = &H00D7F9EA&
Caption = "导入数据过程的快慢视文件中记录的多少而定！"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 210
Left = 720
TabIndex = 4
Top = 5400
Width = 4410
End
Begin VB.Label daoru1
AutoSize = -1 'True
BackColor = &H00D7F9EA&
Caption = "请稍后，数据正在导入..."
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000C000&
Height = 210
Left = 5880
TabIndex = 3
Top = 5400
Width = 2415
End
End
Attribute VB_Name = "trans"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private countAll, countAll2 As Integer '记录记录的总数
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Sub Form_Load()
flggrid.Clear
flggrid.Cols = 10
flggrid.FixedCols = 0
flggrid.FixedRows = 2
flggrid.CellAlignment = 8
'设置各个单元格宽度
flggrid.ColWidth(0) = 1500
flggrid.ColWidth(1) = 1000
flggrid.ColWidth(2) = 1200
flggrid.ColWidth(3) = 1500
flggrid.ColWidth(4) = 1000
flggrid.ColWidth(5) = 1000
flggrid.ColWidth(6) = 1900
flggrid.ColWidth(7) = 900
'设置每一列的内容
flggrid.TextMatrix(0, 0) = "图书大类汇总"
flggrid.TextMatrix(0, 6) = "供应商汇总"
flggrid.TextMatrix(1, 0) = "序 号"
flggrid.TextMatrix(1, 1) = "一级分类编号"
flggrid.TextMatrix(1, 2) = "一级分类名称"
flggrid.TextMatrix(1, 3) = "折 扣"
flggrid.TextMatrix(1, 4) = "码 洋"
flggrid.TextMatrix(1, 5) = "进销差价"
flggrid.TextMatrix(1, 6) = "序 号"
flggrid.TextMatrix(1, 7) = "供应商名称"
flggrid.TextMatrix(1, 8) = "实 洋"
ProgressBar1.Align = vbAlignBottom '进度条位于窗体底部
ProgressBar1.Visible = False '进度条不可用
daoru1.Visible = False
zhu.Visible = True
zhu1.Visible = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "import"
import
Case "build"
build
Case "import2"
import2
Case "exit"
Form_Unload (0)
End Select
End Sub
Private Sub import2()
Dim excel_sheet As Object
Dim count As Integer
Dim row As Integer
Dim excel_app As Excel.Application
Set excel_app = New Excel.Application
Dim importflag As Integer
'打开文件
cd1.Filter = "microsoft excel 文件(*.xls)|*.xls"
cd1.ShowOpen
If (cd1.FileName <> "") And (Dir(cd1.FileName) <> "") Then
importflag = MsgBox("确定要导入的文件是供应商汇总表吗？", vbYesNo)
If (importflag = 6) Then
excel_app.Workbooks.Open FileName:=cd1.FileName
' Check for later versions.
If Val(excel_app.Application.Version) >= 8 Then
Set excel_sheet = excel_app.ActiveSheet
Else
Set excel_sheet = excel_app
End If
'计算记录总数
count = 0
Do Until Trim$(excel_sheet.Cells(count + 3, 1)) = "" ' 如果为空，则表示文件结尾，退出do循环
count = count + 1
Loop
countAll2 = count
ProgressBar1.Max = count 'max值与记录个数值相同
ProgressBar1.Visible = True '当要保存时，使进度条可用
ProgressBar1.Value = ProgressBar1.Min '设置进度的值为 Min。
row = 3
'Dim new_value As String
Do
' Get the next value.
new_value = Trim$(excel_sheet.Cells(row, 1))
If Len(new_value) = 0 Then Exit Do '如果为空，则表示文件结尾，退出do循环
flggrid.TextMatrix(row - 1, 6) = row - 2
flggrid.TextMatrix(row - 1, 7) = Trim$(excel_sheet.Cells(row, 2))
flggrid.TextMatrix(row - 1, 8) = FormatNumber(CCur(Trim$(excel_sheet.Cells(row, 6))), 2)
ProgressBar1.Value = row - 3
' See if it's blank.
flggrid.Rows = flggrid.Rows + 1
row = row + 1
Loop
ProgressBar1.Visible = False
ProgressBar1.Value = ProgressBar1.Min
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -