158 lines
4.7 KiB
VB.net
158 lines
4.7 KiB
VB.net
Attribute VB_Name = "MyRibbon"
|
|
|
|
'namespace=vba-files/ribbons
|
|
|
|
'/*
|
|
'[Ribbon Menu Action]
|
|
'Ribbon Buttom 1 example call code
|
|
'
|
|
'*/
|
|
Public Sub btn1(ByRef control As Office.IRibbonControl)
|
|
On Error GoTo ErrorHandler
|
|
|
|
Dim wb1 As Workbook, wb2 As Workbook
|
|
Dim ws1 As Worksheet, ws2 As Worksheet
|
|
Dim PYEAR As String, PCOMPANY As String, XLSfile As String
|
|
Dim TM As Double, xRow As Long
|
|
|
|
' 初始化變數
|
|
InitializeVariables PYEAR, PCOMPANY, XLSfile
|
|
|
|
' 打開工作簿
|
|
Set wb1 = OpenWorkbook(Excel.ThisWorkbook.path & "\..\..\制服明細.xlsx")
|
|
Set wb2 = OpenWorkbook(Excel.ThisWorkbook.path & XLSfile)
|
|
|
|
' 設置工作表
|
|
Set ws1 = wb1.Sheets("Sheet1")
|
|
Set ws2 = wb2.Sheets("名冊")
|
|
|
|
' 執行主要操作
|
|
TM = Timer
|
|
xRow = 10000
|
|
ProcessData ws1, ws2, xRow
|
|
|
|
' 顯示執行時間
|
|
ws2.Range("AL1").value = Timer - TM
|
|
|
|
' 關閉工作簿
|
|
wb1.Close SaveChanges:=False
|
|
wb2.Close SaveChanges:=True
|
|
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
MsgBox "發生錯誤: " & Err.Description, vbCritical
|
|
On Error Resume Next
|
|
If Not wb1 Is Nothing Then wb1.Close SaveChanges:=False
|
|
If Not wb2 Is Nothing Then wb2.Close SaveChanges:=False
|
|
End Sub
|
|
|
|
Private Sub InitializeVariables(ByRef PYEAR As String, ByRef PCOMPANY As String, ByRef XLSfile As String)
|
|
With ThisWorkbook.Worksheets("售價")
|
|
PYEAR = .Cells(3, 11).value
|
|
PCOMPANY = .Cells(5, 11).value
|
|
XLSfile = .Cells(7, 11).value
|
|
End With
|
|
End Sub
|
|
|
|
Private Function OpenWorkbook(ByVal path As String) As Workbook
|
|
Set OpenWorkbook = Workbooks.Open(path)
|
|
End Function
|
|
|
|
Private Sub ProcessData(ByRef ws1 As Worksheet, ByRef ws2 As Worksheet, ByVal xRow As Long)
|
|
Dim arr As Variant, Brr As Variant, Crr As Variant
|
|
Dim xD As Object
|
|
Dim i As Long
|
|
|
|
' 清除舊數據
|
|
ws2.Columns("AK:AK").Clear
|
|
ws2.Range("AL1").value = ""
|
|
|
|
' 獲取數據
|
|
arr = ws2.Range("F1").Resize(xRow)
|
|
Brr = ws1.Range("A1:F1").Resize(xRow)
|
|
Crr = Range("idx班代碼").Resize(xRow)
|
|
|
|
' 創建字典並填充數據
|
|
Set xD = CreateObject("Scripting.Dictionary")
|
|
FillDictionary xD, Crr, Brr
|
|
|
|
' 更新 Arr 數據
|
|
For i = 1 To UBound(arr)
|
|
If xD.Exists(arr(i, 1)) Then
|
|
arr(i, 1) = xD(arr(i, 1))
|
|
End If
|
|
Next i
|
|
|
|
' 將結果寫回工作表
|
|
ws2.Range("AK1").Resize(xRow) = arr
|
|
End Sub
|
|
|
|
Private Sub FillDictionary(ByRef xD As Object, ByRef Crr As Variant, ByRef Brr As Variant)
|
|
Dim i As Long
|
|
|
|
For i = 1 To UBound(Crr)
|
|
If Not IsEmpty(Crr(i, 1)) Then xD(Crr(i, 1)) = Crr(i, 2)
|
|
Next i
|
|
|
|
For i = 1 To UBound(Brr)
|
|
If Not IsEmpty(Brr(i, 6)) Then xD(Brr(i, 6)) = Brr(i, 4)
|
|
Next i
|
|
End Sub
|
|
|
|
'/*
|
|
'[Ribbon Menu Action]
|
|
'Ribbon Buttom 2 example call code
|
|
'
|
|
'*/
|
|
Public Sub btn2(ByRef control As Office.IRibbonControl)
|
|
' PYEAR 年度 PCOMPANY 公司代碼 XLSfile 同步檔案
|
|
Dim Cnmy As ADODB.Connection
|
|
Dim rstXLS As New ADODB.Recordset
|
|
Dim strSQL As String
|
|
Set Cnmy = Cnmyopen()
|
|
PYEAR = Worksheets("售價").Cells(3, 11)
|
|
PCOMPANY = Worksheets("售價").Cells(5, 11)
|
|
XLSfile = Worksheets("售價").Cells(7, 11)
|
|
Call truncate_data(Cnmy, PYEAR, PCOMPANY)
|
|
strSQL = "Select " & PYEAR & PCOMPANY & " & Format([編號],'0000') AS ID,Format(date(), 'yyyy-mm-dd') as regdate, company,[編號] as studentid,[班ID] as depart,[座號] as seat,[姓名] as c_name, IIf([性別]='男','true','false') AS sex" _
|
|
& ",[胸] as chest, [腰] as waist,[臀] as hip, [長] as leg,[身] as height,[重] as weight, [褲長] as trousers" _
|
|
& ",[學號] as cus_no,IIf([選取]='a','true','false') as tailor" _
|
|
& " FROM [帳務$] order by [編號];"
|
|
' Debug.Print strSQL
|
|
Set rstXLS = rstCnxnopen(XLSfile, strSQL)
|
|
Call insert_data(Cnmy, rstXLS, PYEAR, PCOMPANY)
|
|
rstXLS.Close
|
|
strSQL = "Select " & PYEAR & PCOMPANY & " & Format([編號],'0000') AS ID,IIf([性別]='男',true,false) AS sex" & _
|
|
", [校短尺碼] as itsz1, [校短訂購] as item1, [校長尺碼] as itsz2, [校長訂購] as item2" & _
|
|
", [校夏尺碼] as itsz3, [校夏訂購] as item3, [校冬尺碼] as itsz4, [校冬訂購] as item4, [校裙尺碼] as itsz5, [校裙訂購] as item5" & _
|
|
", [背心尺碼] as itsz6, [背心訂購] as item6, 'A' as itsz7, [領帶訂購] as item7, 'A' as itsz8, [腰帶訂購] as item8" & _
|
|
", 'A' as itsz9, [書包訂購] as item9" & _
|
|
" FROM [帳務$];"
|
|
' Debug.Print strSQL
|
|
Set rstXLS = rstCnxnopen(XLSfile, strSQL)
|
|
Call insert_data2(Cnmy, rstXLS, PYEAR, PCOMPANY)
|
|
rstXLS.Close
|
|
Cnmy.Close
|
|
' 執行SQL上傳
|
|
End Sub
|
|
|
|
|
|
'/*
|
|
'[Ribbon Menu Action]
|
|
'Ribbon Buttom 2 example call code
|
|
'
|
|
'*/
|
|
Public Sub btn3(ByRef control As Office.IRibbonControl)
|
|
|
|
PYEAR = Worksheets("售價").Cells(3, 11)
|
|
PCOMPANY = Worksheets("售價").Cells(5, 11)
|
|
XLSfile = Worksheets("售價").Cells(7, 11)
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|