📄 form4.frm
字号:
EndProperty
EndProperty
End
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 420
Left = 0
TabIndex = 15
Top = 6750
Width = 12855
_ExtentX = 22675
_ExtentY = 741
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 2
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 17640
MinWidth = 17640
Picture = "Form4.frx":1CDF
Text = "复制购进退出单"
TextSave = "复制购进退出单"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 14111
MinWidth = 14111
Text = "辅仁药业集团医药有限公司信息中心---EMPTY开发小组"
TextSave = "辅仁药业集团医药有限公司信息中心---EMPTY开发小组"
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid ms2
Bindings = "Form4.frx":F2F1
Height = 2055
Left = 0
TabIndex = 16
Top = 4800
Width = 11055
_ExtentX = 19500
_ExtentY = 3625
_Version = 393216
Cols = 5
BackColorBkg = -2147483632
FillStyle = 1
SelectionMode = 1
AllowUserResizing= 3
BandDisplay = 1
RowSizingMode = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 5
_Band(0).GridLinesBand= 1
_Band(0).TextStyleBand= 0
_Band(0).TextStyleHeader= 0
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 11160
Top = 3960
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 1
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 3
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Label Label6
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "购进退出"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 615
Left = 10440
TabIndex = 19
Top = 840
Width = 2295
End
Begin VB.OLE OLE1
BackColor = &H00FF0000&
Height = 90
Left = 0
TabIndex = 18
Top = 2160
Width = 11055
End
Begin VB.OLE OLE2
BackColor = &H00FF0000&
Height = 90
Left = 0
TabIndex = 17
Top = 4680
Width = 11055
End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim sql As String
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
cn.Open "DSN=st_ccerp", "sa", "fryy"
sql = "insert into usename(用户名,密码)"
sql = sql & "values('" & Text1.Text & "','" & Text2.Text & "')"
Set rs = cn.Execute(sql)
Adodc1.Refresh
End Sub
Private Sub Command2_Click()
Dim sql As String
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
cn.Open "DSN=st_ccerp", "sa", "fryy"
sql = "delete from usename where 用户名 like '" & Text1.Text & "'"
Set rs = cn.Execute(sql)
Adodc1.Refresh
End Sub
Private Sub Form_Load()
Dim date1 As Date
Dim date2 As Date
date1 = Format(Date, "YYYY-MM-DD")
date2 = Format(Date, "YYYY-MM-DD")
DTP1.Value = date1
DTP2.Value = date2
Adodc1.CommandType = adCmdText
Adodc1.ConnectionString = "st_ccerp"
Adodc1.UserName = "sa"
Adodc1.Password = "fryy"
Adodc2.CommandType = adCmdText
Adodc2.ConnectionString = "st_ccerp"
Adodc2.UserName = "sa"
Adodc2.Password = "fryy"
Adodc3.CommandType = adCmdText
Adodc3.ConnectionString = "st_ccerp"
Adodc3.UserName = "sa"
Adodc3.Password = "fryy"
Adodc4.CommandType = adCmdText
Adodc4.ConnectionString = "furen"
Adodc4.UserName = "sa"
Adodc4.Password = "fryy"
Toolbar1.Buttons(6).Enabled = False
End Sub
Private Sub Form_Resize()
CoolBar1.Width = Me.Width
OLE1.Width = Me.Width
ms1.Width = Me.Width * 99 / 100
ms2.Width = ms1.Width
ms1.Height = Me.Height * 0.8 / 3
ms2.Top = ms1.Top + ms1.Height * 102 / 100
OLE2.Top = ms1.Top + ms1.Height
ms2.Height = Me.Height * 1.3 / 3
OLE2.Width = Me.Width
ms1.ColWidth(0) = 300
ms1.ColWidth(1) = 3000
ms1.ColWidth(2) = 1500
ms2.ColWidth(0) = 300
ms2.ColWidth(1) = 2000
ms2.ColWidth(2) = 2000
ms2.ColWidth(3) = 1500
End Sub
Private Sub ms1_DblClick()
Dim a As String
a = ms1.TextMatrix(ms1.Row, 2)
If a = "" Then
MsgBox "请选择有效的单据号", "64", "袁博提示"
Toolbar1.Buttons(6).Enabled = False
Exit Sub
Else
Adodc2.RecordSource = "select b.spmch,b.shpgg,a.* from jxdjmx a,spkfk b where a.djbh like '" & a & "'and a.spid=b.spid"
Adodc2.Refresh
Toolbar1.Buttons(6).Enabled = True
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim a As String
If KeyAscii = 13 Then
If Text1.Text = "" Then
MsgBox "单位条件不能为空", 64, "系统提示"
Exit Sub
Else
Adodc3.RecordSource = "select dwbh from mchk where zjm like '" & Text1.Text & "'"
Adodc3.Refresh
If Adodc3.Recordset.RecordCount = 0 Then
Exit Sub
Else
a = Adodc3.Recordset.Fields("dwbh")
Text1.Text = a
End If
End If
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "a1"
Dim a As String
Dim b As String
Adodc1.RecordSource = "select b.dwmch,a.* from jxdjhz a,mchk b where a.rq between '" & Format(DTP1.Value, "yyyy-mm-dd") & "'and '" & Format(DTP2.Value, "yyyy-mm-dd") & "'and a.djlx=114 and a.dwbh=b.dwbh and a.yishj='否'and a.is_zx='是'"
Adodc1.Refresh
Case "a2"
Adodc1.RecordSource = "select b.dwmch,a.* from jxdjhz a,mchk b where a.dwbh like '" & Text1.Text & "'and a.dwbh=b.dwbh and a.yishj='否' and a.djlx=114 and a.is_zx='是'"
Adodc1.Refresh
Case "a3"
Adodc1.RecordSource = "select b.dwmch,a.* from jxdjhz a,mchk b where a.rq between '" & Format(DTP1.Value, "yyyy-mm-dd") & "'and '" & Format(DTP2.Value, "yyyy-mm-dd") & "'and a.djlx=114 and a.dwbh like'" & Text1.Text & "'and a.dwbh=b.dwbh and a.yishj='否' and a.is_zx='是'"
Adodc1.Refresh
Case "a4"
b = Text2.Text
Adodc1.RecordSource = "select b.dwmch,a.* from jxdjhz a,mchk b where a.djbh like'" & b & "'and a.dwbh=b.dwbh and a.yishj='否'and a.is_zx='是'"
Adodc1.Refresh
Case "a6"
Dim sql As String
Dim sql2 As String
Dim sql3 As String
Dim sql4 As String
Dim sql5 As String
Dim sql6 As String
Dim sql7 As String
Dim sql8 As String
Dim sql9 As String
Dim sql10 As String
Dim nowdate As String
Dim d As String
Dim e As String
'细单用
Dim f As String
Dim g As String
Dim h As String
Dim i As String
Dim j As String
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Dim rs1 As New ADODB.Recordset
Dim cn1 As New ADODB.Connection
'细单用
Dim rs2 As New ADODB.Recordset
Dim cn2 As New ADODB.Recordset
Dim rs3 As New ADODB.Recordset
Dim cn3 As New ADODB.Connection
Dim c As String
'以下倒主表并修改字段，取新的单据号,取消出库标识
nowdate = Format(Now, "yyyy-mm-dd")
c = ms1.TextMatrix(ms1.Row, 2)
cn.Open "provider=sqloledb;server=192.168.11.5;database=furen;uid=sa;pwd=fryy"
cn1.Open "provider=sqloledb;server=192.168.11.5;database=st_ccerp;uid=sa;pwd=fryy"
sql = "insert into furen.dbo.jxdjhz select * from st_ccerp.dbo.jxdjhz where djbh like '" & c & "'"
sql3 = "select recnum from furen.dbo.maxbh where biaoshi like 'JHT' and mkbh like 'A1'"
Set rs = cn.Execute(sql3)
d = rs.Fields("recnum")
e = d
d = 100000000 + d
d = Right(d, Len(d) - 1)
d = "JHTZDA" + d
sql2 = "update furen.dbo.jxdjhz set djbh='" & d & "',old_djbh='" & c & "', rq='" & nowdate & "',is_zx='否',yishj='否',yitiqu='否' where djbh like '" & c & "'"
Set rs = cn.Execute(sql)
Set rs = cn.Execute(sql2)
e = e + 1
sql4 = "update furen.dbo.maxbh set recnum='" & e & "' where biaoshi like 'JHT' and mkbh like 'A1'"
Set rs = cn.Execute(sql4)
sql5 = "update st_ccerp.dbo.jxdjhz set yishj='是' where djbh like '" & c & "'"
Set rs1 = cn1.Execute(sql5)
Set cn = Nothing
Set cn1 = Nothing
'以下开始倒细表
cn.Open "provider=sqloledb;server=192.168.11.5;database=furen;uid=sa;pwd=fryy"
cn1.Open "provider=sqloledb;server=192.168.11.5;database=st_ccerp;uid=sa;pwd=fryy"
sql6 = "insert into furen.dbo.jxdjmx select * from st_ccerp.dbo.jxdjmx where djbh like '" & c & "'"
Set rs = cn.Execute(sql6)
sql7 = "update furen.dbo.jxdjmx set djbh='" & d & "',is_zx='否',yiwchsl='0',yiwchje='0',yiwchsje='0' where djbh like '" & c & "'"
Set rs = cn.Execute(sql7)
MsgBox "导入成功完毕！", "64", "系统管理员提示"
Adodc1.Refresh
ms2.Clear
ms2.Rows = 0
ms2.Refresh
Toolbar1.Buttons(6).Enabled = False
Case "a7"
Unload Me
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -