📄 transxiaoshou.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 transxiaoshou
BackColor = &H00D7F9E8&
Caption = "销售凭证导入"
ClientHeight = 6690
ClientLeft = 60
ClientTop = 345
ClientWidth = 10515
LinkTopic = "Form1"
ScaleHeight = 6690
ScaleWidth = 10515
StartUpPosition = 2 '屏幕中心
Begin MSComDlg.CommonDialog cd1
Left = 2040
Top = 840
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComctlLib.ImageList ImageList1
Left = 1440
Top = 840
_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 = "transxiaoshou.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "transxiaoshou.frx":00E9
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "transxiaoshou.frx":0243
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "transxiaoshou.frx":0995
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "transxiaoshou.frx":0D43
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 420
Left = 0
TabIndex = 0
Top = 0
Width = 10515
_ExtentX = 18547
_ExtentY = 741
ButtonWidth = 3889
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 = "生成销售凭证文件 "
Key = "build"
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出 "
Key = "exit"
EndProperty
EndProperty
End
Begin MSComctlLib.ProgressBar ProgressBar1
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 1
Top = 6435
Width = 10515
_ExtentX = 18547
_ExtentY = 450
_Version = 393216
Appearance = 1
End
Begin MSFlexGridLib.MSFlexGrid flggrid
Height = 4815
Left = 120
TabIndex = 2
Top = 840
Width = 10215
_ExtentX = 18018
_ExtentY = 8493
_Version = 393216
Rows = 4
Cols = 10
FixedRows = 2
FixedCols = 0
BackColorBkg = 16777215
AllowUserResizing= 1
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 = 5
Top = 5880
Width = 2415
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 = 1320
TabIndex = 4
Top = 5880
Width = 4410
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 = 600
Left = 720
TabIndex = 3
Top = 5880
Width = 420
End
End
Attribute VB_Name = "transxiaoshou"
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) = 1000
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) = "现 金"
flggrid.TextMatrix(1, 9) = "转账支票"
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -