經過前期一年多對金蝶K3生產任務流程和操作的改造和優化,現在總算可以將零件加工各個環節的成本進行歸集了。
原本想寫存儲過程,通過直接SQL報表做到K3中去的,但財務原本就是用EXCEL,可以方便調整和保存,加上還有一部分成本費用需要先分攤再做進去的,所以用VBA做了這個表格。
第一步,是獲取機加任務及工時
在目錄頁中,各按鈕代碼如下,順便將點擊日期保存,以備查
Private Sub CommandButton1_Click()Startview.Show 0CommandButton1.Enabled = FalseActiveSheet.Range("C3") = Now()
End SubPrivate Sub CommandButton2_Click()summary.statisticalCommandButton2.Enabled = FalseActiveSheet.Range("C4") = Now()
End SubPrivate Sub CommandButton3_Click()count.countCommandButton3.Enabled = FalseActiveSheet.Range("C6") = Now()
End SubPrivate Sub CommandButton4_Click()
CommandButton1.Enabled = True
End SubPrivate Sub CommandButton5_Click()
CommandButton2.Enabled = True
End SubPrivate Sub CommandButton6_Click()
CommandButton3.Enabled = True
End SubPrivate Sub CommandButton7_Click()CLWX_JE.getjeCommandButton7.Enabled = FalseActiveSheet.Range("C5") = Now()
End SubPrivate Sub CommandButton8_Click()
CommandButton7.Enabled = True
End Sub
點擊“獲取任務”會跳出一個界面,點擊是后進行查詢。
“確認”按鈕代碼如下
Option ExplicitPublic daymark As Boolean'獲取傳入月份的最大日期Function maxday(year As Integer, month As Integer) As Integermaxday = Day(DateSerial(year, month + 1, 1) - 1)End Function'確認,獲取任務
Private Sub ButtonEnter_Click()gettask.getdateEnd Sub'起始年的CHANGE事件
Private Sub ComboBox1_Change()Dim i As IntegerFor i = 2000 To 3000Me.ComboBox1.AddItem iNextEnd 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.ValueDim i As IntegerMe.ComboBox3.ClearFor i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)Me.ComboBox3.AddItem iNext
End Sub
'起始日的CHANGE事件
Private Sub ComboBox3_Change()
' 當點擊日期時,進行選擇Dim i As IntegerFor i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)Me.ComboBox3.AddItem iNextEnd 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.ValueIf Me.ComboBox2.Value > 12 Or Me.ComboBox2.Value <= 0 ThenMsgBox "起始月份有錯誤"End IfIf Me.ComboBox3.Value > maxday(Me.ComboBox1.Value, Me.ComboBox2.Value) Or Me.ComboBox3.Value <= 0 ThenMsgBox "起始日期有錯誤"End IfEnd Sub
'結束年的CHANGE事件
Private Sub ComboBox4_Change()Dim i As IntegerFor i = 2000 To 3000Me.ComboBox4.AddItem iNextEnd 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 IntegerMe.ComboBox6.ClearFor i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)Me.ComboBox6.AddItem iNextEnd Sub'結束日的CHANGE事件
Private Sub ComboBox6_Change()' 當點擊日期時,進行選擇Dim i As IntegerFor i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)Me.ComboBox6.AddItem iNextEnd 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.ValueIf Me.ComboBox5.Value > 12 Or Me.ComboBox5.Value <= 0 ThenMsgBox "結束月份有錯誤"End IfIf Me.ComboBox6.Value > maxday(Me.ComboBox4.Value, Me.ComboBox5.Value) Or Me.ComboBox6.Value <= 0 ThenMsgBox "結束日期有錯誤"End IfEnd Sub'界面初始化
Private Sub UserForm_Initialize()
' daymark = TrueMe.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.ValueMe.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.ValueMe.Sdate.Visible = FalseMe.Edate.Visible = FalseEnd Sub
點擊確認后,調用 gettask.getdate,獲取起始至結束日期內的任務
Sub getdate()Dim sqlstr As StringDim WS As WorksheetDim rng As RangeDim sheetName As StringDim i As Long, MAXRGN As LongDim objRecDim objConnDim Sdate As Variant, Edate As VariantDim response As VbMsgBoxResultApplication.ScreenUpdating = False '關閉屏幕更新,加快程序運行
Application.DisplayAlerts = False '不顯示警告信息'獲取起止時間Sdate = Startview.Sdate.CaptionEdate = Startview.Edate.CaptionIf Sdate <= Edate Thenresponse = MsgBox("查詢的日期是:" & Sdate & "至" & Edate & "嗎?", vbQuestion + vbYesNo, "確認")If response = vbYes ThenGoTo continueElseExit SubEnd IfElseMsgBox "查詢時間段設置有誤,請檢查"Exit SubEnd If
continue:Unload Startview'''''''''檢查工作表是否存在,不存在則新建一個' 設置要檢查的工作表名稱sheetName = "機加任務及工時"
' ' 遍歷工作簿中的所有工作表,檢查是否存在同名工作表For Each WS In ThisWorkbook.SheetsIf WS.Name = sheetName Theni = 1End IfNext'如果沒有則新增If i = 0 ThenSet WS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))WS.Name = sheetNameEnd If'清除原有數據ActiveWorkbook.Sheets(sheetName).SelectMAXRGN = Worksheets(sheetName).Range("a" & Rows.count).End(xlUp).RowIf MAXRGN <> 0 ThenSet 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.OpenSet objRec = objConn.Execute(sqlstr)If Not objRec.EOF Then'' '將結果集保存到工作表Set WS = ThisWorkbook.Worksheets(sheetName) ''將標題寫入工作表For i = 0 To objRec.Fields.count - 1WS.Cells(1, i + 1).Value = objRec.Fields(i).NameNext iActiveSheet.Range("A2").CopyFromRecordset objRec
''使用方法一或方法二時解除注釋
'' 關閉記錄集和連接objRec.CloseobjConn.Close'
' '釋放對象Set objRec = NothingSet objConn = NothingElseMsgBox "沒有數據,請重新選擇時間段"Exit SubEnd 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 = TrueSheets("目錄").SelectEnd Sub
查詢出的結果 ,有任務的相關信息和所用的工序和工時