?? form8.frm
字號:
EndProperty
End
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 420
Left = 0
TabIndex = 15
Top = 7875
Width = 12825
_ExtentX = 22622
_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 = "Form8.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 = "Form8.frx":F2F1
Height = 2055
Left = 0
TabIndex = 16
Top = 4800
Width = 11055
_ExtentX = 19500
_ExtentY = 3625
_Version = 393216
Cols = 5
BackColorFixed = 12902911
BackColorBkg = 16777215
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.OLE OLE2
BackColor = &H00FF0000&
Height = 90
Left = 0
TabIndex = 19
Top = 4680
Width = 11055
End
Begin VB.OLE OLE1
BackColor = &H00FF0000&
Height = 90
Left = 0
TabIndex = 18
Top = 2160
Width = 11055
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 = 10560
TabIndex = 17
Top = 840
Width = 3015
End
End
Attribute VB_Name = "Form8"
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=213 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=213 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=213 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 'XSV' 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 = "XSVZDA" + 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 'XSV' 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 + -