经过前期一年多对金蝶K3生产任务流程和操作的改造和优化,现在总算可以将零件加工各个环节的成本进行归集了。
原本想写存储过程,通过直接SQL报表做到K3中去的,但财务原本就是用EXCEL,可以方便调整和保存,加上还有一部分成本费用需要先分摊再做进去的,所以用VBA做了这个表格。
第一步,是获取机加任务及工时
在目录页中,各按钮代码如下,顺便将点击日期保存,以备查
Private Sub CommandButton1_Click()
Startview.Show 0
CommandButton1.Enabled = False
ActiveSheet.Range("C3") = Now()
End Sub
Private Sub CommandButton2_Click()
summary.statistical
CommandButton2.Enabled = False
ActiveSheet.Range("C4") = Now()
End Sub
Private Sub CommandButton3_Click()
count.count
CommandButton3.Enabled = False
ActiveSheet.Range("C6") = Now()
End Sub
Private Sub CommandButton4_Click()
CommandButton1.Enabled = True
End Sub
Private Sub CommandButton5_Click()
CommandButton2.Enabled = True
End Sub
Private Sub CommandButton6_Click()
CommandButton3.Enabled = True
End Sub
Private Sub CommandButton7_Click()
CLWX_JE.getje
CommandButton7.Enabled = False
ActiveSheet.Range("C5") = Now()
End Sub
Private Sub CommandButton8_Click()
CommandButton7.Enabled = True
End Sub
点击“获取任务”会跳出一个界面,点击是后进行查询。
“确认”按钮代码如下
Option Explicit
Public daymark As Boolean
'获取传入月份的最大日期
Function maxday(year As Integer, month As Integer) As Integer
maxday = Day(DateSerial(year, month + 1, 1) - 1)
End Function
'确认,获取任务
Private Sub ButtonEnter_Click()
gettask.getdate
End Sub
'起始年的CHANGE事件
Private Sub ComboBox1_Change()
Dim i As Integer
For i = 2000 To 3000
Me.ComboBox1.AddItem i
Next
End Sub
'起始年变更后获取起始日期
Private Sub ComboBox1_Click()
Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
End Sub
'起始月的CHANGE事件
Private Sub ComboBox2_Change()
Me.ComboBox2.List = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12")
End Sub
'起始月变更后获取起始日期
Private Sub ComboBox2_Click()
Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
Dim i As Integer
Me.ComboBox3.Clear
For i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)
Me.ComboBox3.AddItem i
Next
End Sub
'起始日的CHANGE事件
Private Sub ComboBox3_Change()
' 当点击日期时,进行选择
Dim i As Integer
For i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)
Me.ComboBox3.AddItem i
Next
End Sub
'起始日变更后获取起始日期
Private Sub ComboBox3_Click()
Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
End Sub
'起始日变更后确认起始日期
Private Sub ComboBox3_Enter()
Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
If Me.ComboBox2.Value > 12 Or Me.ComboBox2.Value <= 0 Then
MsgBox "起始月份有错误"
End If
If Me.ComboBox3.Value > maxday(Me.ComboBox1.Value, Me.ComboBox2.Value) Or Me.ComboBox3.Value <= 0 Then
MsgBox "起始日期有错误"
End If
End Sub
'结束年的CHANGE事件
Private Sub ComboBox4_Change()
Dim i As Integer
For i = 2000 To 3000
Me.ComboBox4.AddItem i
Next
End Sub
'结束年变更后获取结束日期
Private Sub ComboBox4_Click()
Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
End Sub
'结束月的CHANGE事件
Private Sub ComboBox5_Change()
Me.ComboBox5.List = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12")
End Sub
'结束月变更后获取结束日期
Private Sub ComboBox5_Click()
Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
'当点击月份要做更改时,日期随之变化
Dim i As Integer
Me.ComboBox6.Clear
For i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)
Me.ComboBox6.AddItem i
Next
End Sub
'结束日的CHANGE事件
Private Sub ComboBox6_Change()
' 当点击日期时,进行选择
Dim i As Integer
For i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)
Me.ComboBox6.AddItem i
Next
End Sub
'结束日变更后获取结束日期
Private Sub ComboBox6_Click()
Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
End Sub
'结束日确认后获取结束日期
Private Sub ComboBox6_Enter()
Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
If Me.ComboBox5.Value > 12 Or Me.ComboBox5.Value <= 0 Then
MsgBox "结束月份有错误"
End If
If Me.ComboBox6.Value > maxday(Me.ComboBox4.Value, Me.ComboBox5.Value) Or Me.ComboBox6.Value <= 0 Then
MsgBox "结束日期有错误"
End If
End Sub
'界面初始化
Private Sub UserForm_Initialize()
' daymark = True
Me.ComboBox1.Value = year(Now())
Me.ComboBox2.Value = month(Now())
Me.ComboBox3.Value = Day(Now())
Me.ComboBox4.Value = year(Now())
Me.ComboBox5.Value = month(Now())
Me.ComboBox6.Value = Day(Now())
Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
Me.Sdate.Visible = False
Me.Edate.Visible = False
End Sub
点击确认后,调用 gettask.getdate,获取起始至结束日期内的任务
Sub getdate()
Dim sqlstr As String
Dim WS As Worksheet
Dim rng As Range
Dim sheetName As String
Dim i As Long, MAXRGN As Long
Dim objRec
Dim objConn
Dim Sdate As Variant, Edate As Variant
Dim response As VbMsgBoxResult
Application.ScreenUpdating = False '关闭屏幕更新,加快程序运行
Application.DisplayAlerts = False '不显示警告信息
'获取起止时间
Sdate = Startview.Sdate.Caption
Edate = Startview.Edate.Caption
If Sdate <= Edate Then
response = MsgBox("查询的日期是:" & Sdate & "至" & Edate & "吗?", vbQuestion + vbYesNo, "确认")
If response = vbYes Then
GoTo continue
Else
Exit Sub
End If
Else
MsgBox "查询时间段设置有误,请检查"
Exit Sub
End If
continue:
Unload Startview
'''''''''检查工作表是否存在,不存在则新建一个
' 设置要检查的工作表名称
sheetName = "机加任务及工时"
' ' 遍历工作簿中的所有工作表,检查是否存在同名工作表
For Each WS In ThisWorkbook.Sheets
If WS.Name = sheetName Then
i = 1
End If
Next
'如果没有则新增
If i = 0 Then
Set WS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
WS.Name = sheetName
End If
'清除原有数据
ActiveWorkbook.Sheets(sheetName).Select
MAXRGN = Worksheets(sheetName).Range("a" & Rows.count).End(xlUp).Row
If MAXRGN <> 0 Then
Set rng = ActiveSheet.Range("A1:AZ" & MAXRGN)
rng.Borders.LineStyle = xlNone ' 移除边框
rng.Clear ' 清除数据
End If
'查询语句
sqlstr = sqlstr + " select t1.finterid,t1.FBillNo ,t_Item.fname type,t1.FNote,t2.FNumber,t2.FName, t2.FModel,t1.FQty, "
sqlstr = sqlstr + " convert(varchar,T1.FCommitDate,23) rwxdrq,convert(varchar,t1.fheadselfj01111,23) rkrq, "
sqlstr = sqlstr + "t4.FItemID,t4.FName,t3.Fmaketime from icmo t1 inner join t_icitem t2 on t1.fitemid=t2.FItemID "
sqlstr = sqlstr + " left join t_BOS257800028Entry2 t3 on t3.FID_SRC=t1.FInterID and t3.FBillNo_SRC1=t1.FBillNo "
sqlstr = sqlstr + " left join t_Item_3005 t4 on t3.FBase4=t4.FItemID "
sqlstr = sqlstr + " left join t_Item on t_item.fitemid=t1.FHeadSelfJ01100 and t_item.FItemClassID=3002 "
sqlstr = sqlstr + "where t1.fheadselfj01111 >=" & "'" & Sdate & "'" & " and t1.fheadselfj01111<=" & "'" & Edate & "'" & "order by t1.finterid"
''''''''''''''''''''''''''''''''''''''''
'''使用方法一或方法二时解除注释
''''定义连接对象
Set objRec = CreateObject("ADODB.Recordset")
Set objConn = CreateObject("ADODB.Connection")
''''''''''''''''''''''''''''''''''''''''''
'''方法一: 数据量大时速度较慢
'' '执行查询并获取结果集
'' 连接数据库并执行SQL语句
objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=192.168.100.3;Initial Catalog=AIS20150813141843;User ID=sa;Password=Chr_2016"
objConn.Open
Set objRec = objConn.Execute(sqlstr)
If Not objRec.EOF Then
'' '将结果集保存到工作表
Set WS = ThisWorkbook.Worksheets(sheetName) '
'将标题写入工作表
For i = 0 To objRec.Fields.count - 1
WS.Cells(1, i + 1).Value = objRec.Fields(i).Name
Next i
ActiveSheet.Range("A2").CopyFromRecordset objRec
''使用方法一或方法二时解除注释
'' 关闭记录集和连接
objRec.Close
objConn.Close
'
' '释放对象
Set objRec = Nothing
Set objConn = Nothing
Else
MsgBox "没有数据,请重新选择时间段"
Exit Sub
End If
'''''''''''''''''''''''''''''''''''''''
''''方法二:速度比方法一快,且自带标题(WPS下有效,但EXCEL下报错)
''
'' 执行查询并将结果存储在记录集对象中
'' '连接数据库并执行SQL语句
'' objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=192.168.100.3;Initial Catalog=AIS20150813141843;User ID=sa;Password=Chr_2016"
''
'' objConn.Open
'' objRec.Open sqlstr, objConn
''
'' If Not objRec.EOF Then
''
'' 设置工作表对象
'' Set WS = ThisWorkbook.Sheets(sheetName) ' 可以更改为你要写入数据的工作表名称
'' 将数据写入工作表
'' With WS.QueryTables.Add(Connection:=objRec, Destination:=WS.Range("A1"))
'''' .TextFileParseType = xlFixedWidth '指示将文件中的数据排列在固定宽度的列中'xlDelimited 默认值。 指示文件由分隔符分隔
'''' .TextFileCommaDelimiter = True ' 根据需要更改分隔符,这里使用逗号作为分隔符
'''' .Refresh BackgroundQuery:=False ' 或使用 .Execute,然后在下一行添加总计行(如果有)并刷新查询表格以获取数据。
'' .Refresh
'' End With
''''使用方法一或方法二时解除注释
''' 关闭记录集和连接
'' objRec.Close
'' objConn.Close
''
'''
'' '释放对象
'' Set objRec = Nothing
'' Set objConn = Nothing
'
'
'' Else
''
'' MsgBox "没有数据,请重新选择时间段"
'' Exit Sub
'' End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
''''方法三:此方法在WPS下报错,但在EXCEL中能执行成功
'' ActiveWorkbook.Queries(1).Delete
'' ActiveWorkbook.Queries.Add Name:="查询1", Formula:= _
'' "let" & Chr(13) & "" & Chr(10) & " 源 = Odbc.Query(""dsn=CHR"", """ & sqlstr & """)," _
'' & Chr(13) & "" & Chr(10) & " 重命名的列 = Table.RenameColumns(源,{{""FName"", ""FName.1""}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " 重命名的列" & ""
'
' ActiveWorkbook.Queries.Add Name:="查询1", Formula:= _
' "let" & Chr(13) & "" & Chr(10) & " 源 = Odbc.Query(""dsn=CHR"", """ & sqlstr & """)" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " 源" & ""
'
'
' '' 设置工作表对象
' Set WS = ThisWorkbook.Sheets(sheetName) ' 可以更改为你要写入数据的工作表名称
' With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
' "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=查询1;Extended Properties=""""" _
' , Destination:=WS.Range("$A$1")).QueryTable
' .CommandType = xlCmdSql
' .CommandText = Array("SELECT * FROM [查询1]")
' .RowNumbers = False
'' .FillAdjacentFormulas = False
'' .PreserveFormatting = True
'' .RefreshOnFileOpen = False
'' .BackgroundQuery = True
'' .RefreshStyle = xlInsertDeleteCells
'' .SavePassword = False
'' .SaveData = True
'' .AdjustColumnWidth = True
'' .RefreshPeriod = 0
'' .PreserveColumnInfo = False
'' .ListObject.DisplayName = "查询1"
' .Refresh BackgroundQuery:=True '后台进行查询,false时会跳出对话框
' End With
'' Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
' ActiveWorkbook.Queries(1).Delete '删除查询
''''''''''''''''''''''''''''''''
moformat.format
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets("目录").Select
End Sub
查询出的结果 ,有任务的相关信息和所用的工序和工时