📄 form9.frm
字号:
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid ms2
Bindings = "Form9.frx":F2F1
Height = 2055
Left = 0
TabIndex = 7
Top = 4800
Width = 9735
_ExtentX = 17171
_ExtentY = 3625
_Version = 393216
Cols = 5
BackColorFixed = 12648447
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 = 5160
Top = 1440
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 = &H00FF0000&
Height = 615
Left = 3360
TabIndex = 10
Top = 720
Width = 3015
End
Begin VB.OLE OLE1
BackColor = &H00FF0000&
Height = 90
Left = 0
TabIndex = 9
Top = 2160
Width = 9615
End
Begin VB.OLE OLE2
BackColor = &H00FF0000&
Height = 90
Left = 0
TabIndex = 8
Top = 4680
Width = 9615
End
End
Attribute VB_Name = "Form9"
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")
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"
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", "袁博提示"
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
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"
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 "a3"
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 = "update st_ccerp.dbo.jxdjhz set yishj='否' where djbh like '" & c & "'"
sql3 = "select djbh from furen.dbo.jxdjhz where old_djbh like '" & c & "'"
Set rs = cn.Execute(sql)
Set rs1 = cn1.Execute(sql3)
d = rs1.Fields("djbh")
sql4 = "delete from furen.dbo.jxdjmx where djbh like '" & d & "'" '删除细单单据
sql5 = "delete from furen.dbo.jxdjhz where djbh like'" & d & "'" '删除主单单据
Set rs1 = cn1.Execute(sql4)
Set rs1 = cn1.Execute(sql5)
Set cn = Nothing
Set cn1 = Nothing
MsgBox "回溯单据成功完毕！", "64", "系统管理员提示"
Adodc1.Refresh
ms2.Clear
ms2.Rows = 0
ms2.Refresh
Case "a5"
Unload Me
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -