📄 cpcopy.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Object = "{4F29B06F-16D9-4A0C-9C8A-2F0C02F625FE}#1.0#0"; "FlexCell.ocx"
Begin VB.Form cpcopy
Caption = "cpcopy"
ClientHeight = 7470
ClientLeft = 60
ClientTop = 450
ClientWidth = 11895
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 7470
ScaleWidth = 11895
Begin MSComCtl2.MonthView MonthView1
Height = 2370
Left = 6750
TabIndex = 9
Top = 960
Width = 4065
_ExtentX = 7170
_ExtentY = 4180
_Version = 393216
ForeColor = -2147483630
BackColor = -2147483633
Appearance = 1
StartOfWeek = 65077249
CurrentDate = 39000
End
Begin FlexCell.Grid Grid2
Height = 5235
Left = 8850
TabIndex = 8
Top = 1320
Width = 2985
_ExtentX = 5265
_ExtentY = 9234
Cols = 5
Rows = 30
End
Begin FlexCell.Grid Grid1
Height = 5370
Left = 0
TabIndex = 7
Top = 1200
Width = 8775
_ExtentX = 15478
_ExtentY = 9472
Cols = 5
Rows = 30
End
Begin VB.CommandButton cmddate
Caption = "Command1"
Height = 255
Left = 5940
TabIndex = 0
Top = 900
Width = 195
End
Begin VB.CommandButton cmdexit
Caption = "退出"
Height = 315
Left = 10440
TabIndex = 5
Top = 6660
Width = 855
End
Begin VB.CommandButton cmdcopy
Caption = "开始复制"
Height = 315
Left = 8820
TabIndex = 4
Top = 6660
Width = 1215
End
Begin VB.TextBox txtcode
Height = 315
Left = 9120
TabIndex = 3
Top = 240
Width = 855
End
Begin MSMask.MaskEdBox mskdate
Height = 315
Left = 4740
TabIndex = 2
Top = 840
Width = 1155
_ExtentX = 2037
_ExtentY = 556
_Version = 393216
PromptChar = "_"
End
Begin VB.Label Label2
Caption = "日期"
Height = 255
Left = 4260
TabIndex = 6
Top = 900
Width = 435
End
Begin VB.Label Label1
Caption = "产品信息复制"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 4320
TabIndex = 1
Top = 60
Width = 2715
End
End
Attribute VB_Name = "cpcopy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim oldcpbh As String, newcpbh As String
Dim currow As Integer
Private Sub Form_Load()
Me.Width = 12000
Me.Height = 8000
dogridfirst
dogridfill1
dogridfill2
mskdate.Text = Format(NOWDate, "yyyy-mm-dd") '默认填制日期为当天
' dogridfind '产品表内容
Set rsTempA = oDb.Execute("select max(code) as maxcode from acp where dhrq= '" & mskdate.Text & "'") 'code号初始
If IsNull(rsTempA!maxcode) Then
txtcode.Text = 1
Else
txtcode.Text = rsTempA!maxcode + 1
End If
txtcode.Visible = False
MonthView1.Visible = False
MonthView1.Value = NOWDate
End Sub
Private Sub cmdcopy_Click()
'先检查选中哪个产品（编号），只能唯一
'检查复制哪几项，插入对应的表，新产品编号为日期＋code
j = 0
For i = 1 To Grid1.Rows - 1
If Grid1.Cell(i, 1).IntegerValue = 1 Then '选中
j = j + 1
End If
Next i
If j = 0 Then
MsgBox "没有选择所要复制的产品", vbOKOnly, "选择"
Exit Sub
End If
If j > 1 Then
MsgBox "所选复制的产品一次不能超过一个", vbOKOnly, "选择"
Exit Sub
End If
If Grid2.Cell(1, 3).IntegerValue = 0 Then
MsgBox "产品部件必须复制", vbOKOnly, "选择"
Exit Sub
End If
'复制开始
'产品及部件
newcpbh = Left(mskdate.Text, 4) & Mid(mskdate.Text, 6, 2) & Mid(mskdate.Text, 9, 2) & Format$(txtcode.Text, "00")
For i = 1 To Grid1.Rows - 1
If Grid1.Cell(i, 1).IntegerValue = 1 Then currow = i
Next i
oldcpbh = Grid1.Cell(currow, 2).Text
Set rsTempA = oDb.Execute("select * from acp where cpbh='" & oldcpbh & "'")
griditem = "'" & newcpbh & "'," & txtcode.Text & ",'" & rsTempA!cpmc & "','" & rsTempA!cpxh & "'," & rsTempA!dhbh & ",'" & rsTempA!dhmc & "','" & mskdate.Text & "','Y','copy'"
szSql = "insert acp (cpbh,code,cpmc,cpxh,dhbh,dhmc,dhrq,cpyn,cpbz) values (" & griditem & ")"
oDb.Execute (szSql)
Set rsTempA = oDb.Execute("select * from abj where cpbh='" & oldcpbh & "' order by code")
i = rsTempA.RecordCount
Do Until rsTempA.EOF
griditem = "'" & newcpbh & "','" & rsTempA!cpmc & "','" & rsTempA!cpxh & "'," & rsTempA!code & ",'" & (newcpbh & Right(rsTempA!bjbh, 4)) & "','" & rsTempA!bjmc & "','" & Trim(rsTempA!bjth) & "'"
If IsNull(rsTempA!bjtotgs) Then
griditem = griditem & "," & rsTempA!bjsl & "," & rsTempA!bjzl & ",'" & mskdate.Text & "','" & mskdate.Text & "',0"
Else
griditem = griditem & "," & rsTempA!bjsl & "," & rsTempA!bjzl & ",'" & mskdate.Text & "','" & mskdate.Text & "'," & rsTempA!bjtotgs & ""
End If
szSql = "insert abj (cpbh,cpmc,cpxh,code,bjbh,bjmc,bjth ,bjsl,bjzl,bjdate1,bjdate2,bjtotgs) values (" & griditem & ")"
oDb.Execute (szSql)
rsTempA.MoveNext
Loop
'零件
If Grid2.Cell(2, 3).IntegerValue = 1 Then
Set rsTempA = oDb.Execute("select * from alj where left(bjbh,10)='" & oldcpbh & "' order by code")
Do Until rsTempA.EOF
griditem = "'" & newcpbh & Right(rsTempA!bjbh, 4) & "','" & rsTempA!bjmc & "'," & rsTempA!code & ",'" & newcpbh & Right(rsTempA!ljbh, 8) & "','" & rsTempA!ljmc & "','" & rsTempA!ljth & "'"
griditem = griditem & "," & rsTempA!ljsl & ",'" & rsTempA!ljqx & "','copy'"
szSql = "insert alj (bjbh,bjmc,code,ljbh,ljmc,ljth,ljsl,ljqx,ljbz) values (" & griditem & ")"
oDb.Execute (szSql)
rsTempA.MoveNext
Loop
End If
'进度表
If Grid2.Cell(3, 3).IntegerValue = 1 Then
'部件工时
Set rsTempA = oDb.Execute("select * from ajdbj where cpbh='" & oldcpbh & "' order by gxbh")
Do Until rsTempA.EOF
griditem = "'" & newcpbh & "','" & newcpbh & Right(rsTempA!bjbh, 4) & "','" & rsTempA!gxbh & "','" & rsTempA!gxmc & "'," & rsTempA!gxgs & ""
szSql = "insert ajdbj (cpbh,bjbh,gxbh,gxmc,gxgs) values (" & griditem & ")"
oDb.Execute (szSql)
rsTempA.MoveNext
Loop
'零件工时
Set rsTempA = oDb.Execute("select * from ajdlj where left(bjbh,10)='" & oldcpbh & "' order by code")
Do Until rsTempA.EOF
griditem = "'" & newcpbh & Right(rsTempA!bjbh, 4) & "'," & rsTempA!code & ",'" & newcpbh & Right(rsTempA!ljbh, 8) & "','" & rsTempA!ljmc & "','" & rsTempA!ljth & "'"
griditem = griditem & "," & rsTempA!ljsl & ",'" & rsTempA!gxbh1 & "','" & rsTempA!gxmc1 & "'," & rsTempA!gxgs1 & ",'" & rsTempA!gxbh2 & "','" & rsTempA!gxmc2 & "'," & rsTempA!gxgs2 & ""
griditem = griditem & ",'" & rsTempA!gxbh3 & "','" & rsTempA!gxmc3 & "'," & rsTempA!gxgs3 & ",'" & rsTempA!gxbh4 & "','" & rsTempA!gxmc4 & "'," & rsTempA!gxgs4 & ""
griditem = griditem & ",'" & rsTempA!gxbh5 & "','" & rsTempA!gxmc5 & "'," & rsTempA!gxgs5 & ",'" & rsTempA!gxbh6 & "','" & rsTempA!gxmc6 & "'," & rsTempA!gxgs6 & ""
griditem = griditem & ",'" & rsTempA!gxbh7 & "','" & rsTempA!gxmc7 & "'," & rsTempA!gxgs7 & ",'" & rsTempA!gxbh8 & "','" & rsTempA!gxmc8 & "'," & rsTempA!gxgs8 & ""
griditem = griditem & ",'" & rsTempA!gxbh9 & "','" & rsTempA!gxmc9 & "'," & rsTempA!gxgs9 & ",'" & rsTempA!gxbh10 & "','" & rsTempA!gxmc10 & "'," & rsTempA!gxgs10 & ""
griditem = griditem & ",'" & rsTempA!gxbh11 & "','" & rsTempA!gxmc11 & "'," & rsTempA!gxgs11 & ",'" & rsTempA!gxbh12 & "','" & rsTempA!gxmc12 & "'," & rsTempA!gxgs12 & ""
griditem = griditem & ",'" & rsTempA!ljqx & "','copy'"
szSql = "insert ajdlj (bjbh,code,ljbh,ljmc,ljth,ljsl,gxbh1,gxmc1,gxgs1,gxbh2,gxmc2,gxgs2,gxbh3,gxmc3,gxgs3,gxbh4,gxmc4,gxgs4,gxbh5,gxmc5,gxgs5,gxbh6,gxmc6,gxgs6,gxbh7,gxmc7,gxgs7,gxbh8,gxmc8,gxgs8,gxbh9,gxmc9,gxgs9,gxbh10,gxmc10,gxgs10,gxbh11,gxmc11,gxgs11,gxbh12,gxmc12,gxgs12,ljqx,ljbz) values (" & griditem & ")"
oDb.Execute (szSql)
rsTempA.MoveNext
Loop
End If
MsgBox "OK，复制完成！", vbOKOnly, "copy"
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub dogridfirst()
'表格1－产品信息表
Grid1.AutoRedraw = False
Grid1.DisplayFocusRect = False
Grid1.Cols = 10
Grid1.Rows = 1
Grid1.FixedRows = 1
Grid1.Column(0).Width = 5
Grid1.Column(1).Width = 40
Grid1.Column(2).Width = 80
Grid1.Column(3).Width = 110
Grid1.Column(4).Width = 110
Grid1.Column(5).Width = 50
Grid1.Column(6).Width = 150
Grid1.Column(7).Width = 70
Grid1.Column(8).Width = 40
Grid1.Column(9).Width = 2
Grid1.AutoRedraw = True
Grid1.Refresh
Grid1.Column(2).Locked = True '产品编号与单位编号、名称不能修改
'Grid1.Column(8).Locked = True
Grid1.Column(1).CellType = cellCheckBox
'表格2－copy
Grid2.AutoRedraw = False
Grid2.AllowUserResizing = True
Grid2.DisplayFocusRect = False
Grid2.Cols = 4
Grid2.FixedRows = 1
Grid2.Column(0).Width = 2
Grid2.Column(1).Width = 30
Grid2.Column(2).Width = 100
Grid2.Column(3).Width = 50
Grid2.AutoRedraw = True
Grid2.Refresh
Grid2.Column(2).Locked = True
Grid2.Column(3).CellType = cellCheckBox
End Sub
Private Sub dogridfill1()
Grid1.Cell(0, 1).Text = "选择"
Grid1.Cell(0, 2).Text = "产品编号"
Grid1.Cell(0, 3).Text = "产品名称"
Grid1.Cell(0, 4).Text = "产品型号"
Grid1.Cell(0, 5).Text = "单位编号"
Grid1.Cell(0, 6).Text = "订货单位"
Grid1.Cell(0, 7).Text = "填制日期"
Grid1.Cell(0, 8).Text = "是否统计"
Grid1.Cell(0, 9).Text = "code"
Grid1.Rows = 1
Set rsTempA = oDb.Execute("select * from acp order by cpmc,cpbh")
Do Until rsTempA.EOF
Grid1.AddItem "" & Chr(9) & rsTempA!cpbh & Chr(9) & rsTempA!cpmc & Chr(9) & rsTempA!cpxh & Chr(9) & rsTempA!dhbh & Chr(9) & rsTempA!dhmc & Chr(9) & rsTempA!dhrq & Chr(9) & rsTempA!cpyn & Chr(9) & rsTempA!code
rsTempA.MoveNext
Loop
End Sub
'以下为表格2的操作
Private Sub dogridfill2()
Grid2.Cell(0, 1).Text = "序号"
Grid2.Cell(0, 2).Text = "copy项目"
Grid2.Cell(0, 3).Text = "项目选择"
Grid2.Rows = 1
Grid2.AddItem Grid2.Rows & Chr(9) & "部件copy"
Grid2.AddItem Grid2.Rows & Chr(9) & "零件copy"
Grid2.AddItem Grid2.Rows & Chr(9) & "进度表copy"
'Grid2.Cell(1, 3).SingleValue = 1
'Grid2.Cell(2, 3).IntegerValue = 1
End Sub
Private Sub cmddate_Click()
MonthView1.Visible = True
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
MonthView1.Visible = False
mskdate.Text = Format(MonthView1.Value, "YYYY-MM-DD")
Set rsTempA = oDb.Execute("select max(code) as maxcode from acp where dhrq= '" & mskdate.Text & "'") 'code号初始
If IsNull(rsTempA!maxcode) Then
txtcode.Text = 1
Else
txtcode.Text = rsTempA!maxcode + 1
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -