198188

¦^´_  198188


    §â¶Ã½Xªº¤u§@ªí¦W§ï±¼¸Õ¸Õ¬Ý
Andy2483 µoªí©ó 2025-11-3 16:43

¤U¸ü (95.9 KB)

3 ¤Ñ«e 17:32

µLªk­×§ï

Andy2483

¦^´_ 151# 198188


    ³Ò·Ð«e½ú±N¥þ³¡¸ê®Æ½Æ»s¤@¥÷¨ì·s¼W¬¡­¶Ã¯ª½¨ì¤u§@ªí¦W¨S¦³¶Ã½X¡A¦A½Æ»s¥N½X°õ¦æ¬Ý¬Ý

Andy2483

¦^´_ 151# 198188


    FORM Åܧó¦p¤U:

Option Explicit
Public A, Z, R&, W, L, i&, Brr, Mrr, Q, Drr, j%, MyPath$
Sub Form()
Dim Arr, Crr(1 To 100000, 1 To 18), xW$, S, T$, T2$, Ts, xFile$, xBook As Workbook, Re
Ts = Timer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MyPath = ThisWorkbook.Path & "\"
xFile = "Data Base.xlsx"
On Error Resume Next
Set xBook = Workbooks(xFile)
If xBook Is Nothing Then
   Set xBook = Workbooks.Open(MyPath & xFile, , True, , "")
   Re = True: ThisWorkbook.Activate
End If
On Error GoTo 0
Mrr = xBook.Sheets("Material").UsedRange
If Re = True Then xBook.Close 0
Call RuleRun

For i = 2 To UBound(Mrr): Z(Mrr(i, 3) & "/m") = i: Next
For i = Worksheets.Count To 1 Step -1
   If Z(Sheets(i).Name & "/s") <> "" Then Sheets(i).Delete
Next
If Sheets("Part List").FilterMode = True Then Sheets("Part List").ShowAllData
With Range(Sheets("Part List").[P1], Sheets("Part List").[A65536].End(3)(2))
   With .Columns(15): .Cells = "=ROW()": .Value = .Value: End With
   Brr = .Value
   ReDim Arr(1 To UBound(Brr) - 1, 1 To 1)
   For i = 2 To UBound(Brr)
      T = Left(Brr(i, 1), 2) & "-" & Brr(i, 7)
      If InStr("Y-O", Right(T, 1)) Then Arr(i - 1, 1) = Z(T)
   Next
   .Cells(2, 16).Resize(UBound(Brr) - 1, 1) = Arr
   .Sort KEY1:=.Item(16), Order1:=1, Header:=1
   Brr = .Value
   .Sort KEY1:=.Item(15), Order1:=1, Header:=1
   .Cells(1, 15).Resize(, 2).EntireColumn.Delete
   A = Crr
   For i = 2 To UBound(Brr) - 1
      If Brr(i, 16) = "" Then Exit For Else T = Brr(i, 16)
      R = R + 1: A(R, 1) = R: Run Replace(Z(T & "/s"), " ", "_")
      If T <> Brr(i + 1, 16) Then
         Sheets(Z(T & "/s")).Copy Before:=Sheets(1)
         ActiveSheet.Name = T
         With Cells(Z(Z(T & "/s") & "/UR"), 1).Resize(R, Z(Z(T & "/s") & "/UC"))
            .Value = A
            .Borders.LineStyle = xlContinuous
            ActiveSheet.PageSetup.PrintArea = Range([A1], .Cells).Address
         End With
         With Range(Z(Z(T & "/s") & "/V1")): .Value = Z(T & "/EC"): .ShrinkToFit = True: End With
         With Range(Z(Z(T & "/s") & "/V2")): .Value = Z(T & "/ER"): .ShrinkToFit = True: End With
         A = Crr: R = 0
      End If
   Next
End With
ThisWorkbook.Activate
If Sheets("Frame per Dwg").FilterMode = True Then Sheets("Frame per Dwg").ShowAllData
With Range(Sheets("Frame per Dwg").[I1], Sheets("Frame per Dwg").[A65536].End(3)(2))
   With .Columns(8): .Cells = "=ROW()": .Value = .Value: End With
   Drr = .Value
   ReDim Arr(1 To UBound(Drr) - 1, 1 To 1)
   For i = 2 To UBound(Drr)
      T = Left(Drr(i, 2), 2) & "-" & Drr(i, 6)
      If InStr("WT", Right(T, 1)) Then Arr(i - 1, 1) = Z(T)
   Next
   .Cells(2, 9).Resize(UBound(Drr) - 1, 1) = Arr
   .Sort KEY1:=.Item(9), Order1:=1, Header:=1
   Drr = .Value
   .Sort KEY1:=.Item(8), Order1:=1, Header:=1
   .Cells(1, 8).Resize(, 2).EntireColumn.Delete
   A = Crr: R = 0
   For i = 2 To UBound(Drr) - 1
      If Drr(i, 9) = "" Then Exit For Else T = Drr(i, 9)
      R = R + 1: A(R, 1) = R: Run Replace(Z(T & "/s"), " ", "_")
      If T <> Drr(i + 1, 9) Then
         Sheets(Z(T & "/s")).Copy Before:=Sheets(1)
         ActiveSheet.Name = T
         With Cells(Z(Z(T & "/s") & "/UR"), 1).Resize(R, Z(Z(T & "/s") & "/UC"))
            .Value = A
            .Borders.LineStyle = xlContinuous
            ActiveSheet.PageSetup.PrintArea = Range([A1], .Cells).Address
         End With
         With Range(Z(Z(T & "/s") & "/V1")): .Value = Z(T & "/EC"): .ShrinkToFit = True: End With
         With Range(Z(Z(T & "/s") & "/V2")): .Value = Z(T & "/ER"): .ShrinkToFit = True: End With
         A = Crr: R = 0
      End If
   Next
End With
Set Z = Nothing
Erase Arr, Brr, Crr, Drr, A, Mrr
MsgBox "¦@¯Ó®É¡G" & Timer - Ts & " ¬í"
End Sub
'________________________________________________________
Sub RuleRun()
Dim T$, T2$, S$, i&, j%
Set Z = CreateObject("Scripting.Dictionary")
Brr = [Rule!A1].CurrentRegion
For i = 3 To UBound(Brr)
   For j = 2 To 8
      T = Brr(i, j)
      If T <> "" Then
         If Z(T & "|") = "" Then
            Z(T & "^") = Brr(2, j)
            Z(T & "|") = Trim(Mid(Brr(2, j), 1, Len(Brr(2, j)) * 2 - LenB(StrConv(Brr(2, j), vbFromUnicode)) - 2))
         End If
         Exit For
      End If
   Next
   For j = 11 To 28
      If Brr(i, j) = "" Then Exit For
      T2 = Brr(i, 11) & "-" & T
      Z(Brr(i, j) & "-" & T) = T2
      If Z(T2 & "/") = "" Then
         Z(T2 & "/") = Brr(i, 9) & "-" & Z(T & "|")
         Z(T2 & "/EC") = Brr(i, 9) & "-" & Brr(i, 10)
         Z(T2 & "/ER") = Z(T & "^")
      End If
      S = Brr(i, 1)
      Z(T2 & "/s") = S
      Z(S & "/UR") = Sheets(S).[A65536].End(3)(2).Row
      Z(S & "/UC") = Sheets(S).Cells(Z(S & "/UR") - 1, 256).End(xlToLeft).Column
      Z(S & "/V1") = Switch(S = "Bom", "A4", S = "Gasket", "D6", S = "Structural", "C3", S = "Fabrication Extrusion", "A3", S = "Finish", "A3", S = "DN Material", "A3")
      Z(S & "/V2") = Switch(S = "Bom", "A5", S = "Gasket", "D7", S = "Structural", "C4", S = "Fabrication Extrusion", "A4", S = "Finish", "A4", S = "DN Material", "A4")
   Next
Next
End Sub

Sub Bom()
A(R, 2) = Brr(i, 1)
A(R, 3) = Brr(i, 12)
If A(R, 3) <> "" And Z.Exists(A(R, 3) & "/m") Then
   For j = 0 To 5: A(R, Array(4, 5, 6, 8, 9, 13)(j)) = Mrr(Z(A(R, 3) & "/m"), Array(5, 6, 7, 11, 10, 8)(j)): Next
End If
A(R, 7) = Brr(i, 4) & " x " & Brr(i, 5)
A(R, 10) = Brr(i, 3)
A(R, 18) = Brr(i, 7)
End Sub

Sub Gasket()
For j = 0 To 5: A(R, Array(2, 9, 6, 7, 11, 3)(j)) = Brr(i, Array(1, 3, 5, 6, 7, 12)(j)): Next
If A(R, 3) <> "" And Z.Exists(A(R, 3) & "/m") Then
   For j = 0 To 2: A(R, Array(4, 5, 8)(j)) = Mrr(Z(A(R, 3) & "/m"), Array(5, 6, 8)(j)): Next
End If
End Sub

Sub Structural()
For j = 0 To 2: A(R, Array(2, 3, 5)(j)) = Brr(i, Array(1, 2, 3)(j)): Next
L = Split(Brr(i, 2) & "mm", "mm")(0)
W = Split(Brr(i, 2) & "mm", "mm")(1)
L = Val(StrReverse(Mid(Val(StrReverse(L & 1)), 2)))
W = Val(StrReverse(Mid(Val(StrReverse(W & 1)), 2)))
A(R, 6) = L * W
A(R, 8) = A(R, 5) * A(R, 6) / 1000
A(R, 7) = Application.RoundUp(A(R, 5) * A(R, 6) / 1000, 0)
End Sub

Sub DN_Material()
For j = 0 To 3: A(R, Array(2, 3, 4, 7)(j)) = Brr(i, Array(1, 12, 5, 3)(j)): Next
If A(R, 3) <> "" And Z.Exists(A(R, 3) & "/m") Then
   A(R, 5) = Mrr(Z(A(R, 3) & "/m"), 11)
   A(R, 6) = Mrr(Z(A(R, 3) & "/m"), 8)
   A(R, 8) = A(R, 5) * A(R, 7)
End If
A(R, 9) = Brr(i, 7)
End Sub

Sub Fabrication_Extrusion()
For j = 0 To 5: A(R, Array(2, 3, 4, 5, 6, 7)(j)) = Brr(i, Array(1, 11, 10, 4, 3, 1)(j)): Next
If A(R, 7) Like "*-*-*" Then
   Q = Split(A(R, 7), "-")
   A(R, 7) = Q(0) & "-" & Q(1)
End If
A(R, 8) = Brr(i, 7)
End Sub

Sub Finish()
For j = 0 To 4: A(R, Array(2, 3, 4, 5, 7)(j)) = Drr(i, Array(2, 3, 4, 5, 6)(j)): Next
End Sub

Andy2483

¦^´_ 151# 198188


    PDFÀɲ£¥X¤è®×¦p¤U:

Option Explicit
Sub Print_PDF()
Dim T$, NewMyPath, Pj, PP$, Dn$
Application.ScreenUpdating = False
Call RuleRun

Dn = Format(Now, "yyyy_mm_dd_hh_nn_ss")
Pj = ['WO No'!A2].Resize(, 11): Pj = Replace(Join(Application.Transpose(Application.Transpose(Pj)), "_"), "/", "_")
NewMyPath = ThisWorkbook.Path & "\" & Pj & "\"
If Dir(NewMyPath, vbDirectory) = "" Then MkDir NewMyPath
NewMyPath = NewMyPath & Dn & "\"
MkDir NewMyPath
For i = Worksheets.Count To 1 Step -1
   T = Sheets(i).Name & "/s"
   If Z(T) <> "" Then
      Sheets(i).ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewMyPath & Z(Sheets(i).Name & "/") & "_" & Dn & ".pdf", _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
   End If
Next
MsgBox "PDF_Save_Address: " & vbLf & NewMyPath
End Sub

Andy2483

¦^´_ 151# 198188


    Dataªº­×§ï¤è®×¤]´£¨Ñ°Ñ¦Ò:

Sub Data()
Dim Arr, Brr, Crr, Z, Q, S, i&, j%, N&, T$, T1$, MyPath$, xFile$, xBook As Workbook, Re, R&
Application.ScreenUpdating = False
For Each S In [{"Layout Dwg","Frame per Dwg","Part List"}]
   Sheets(S).UsedRange.Rows.Offset(1).EntireRow.Delete
Next
MyPath = ThisWorkbook.Path & "\"
xFile = "Data Base.xlsx"
On Error Resume Next
Set xBook = Workbooks(xFile)
If xBook Is Nothing Then
   Set xBook = Workbooks.Open(MyPath & xFile, , True, , "")
   Re = True: ThisWorkbook.Activate
End If
On Error GoTo 0
Set Z = CreateObject("Scripting.Dictionary")
T = Sheets("Read").[A2] & "|" & Sheets("Read").[C2]
T1 = Sheets("Read").[B2]
With xBook.Sheets("WO No")
   For i = 2 To .[A65536].End(3).Row
      If .Cells(i, "B") & "|" & .Cells(i, "D") = T Then
         .Rows(i).Copy Sheets("WO No").Rows(2)
         For j = 6 To 11
            Z("|" & .Cells(i, j)) = ""
         Next
         Sheets("Read").[A2].Resize(, 3).Copy Sheets("WO No").[B2]
         GoTo 11
      End If
   Next
   MsgBox "Nothing": Exit Sub
End With
11
If T1 Like "##F-*##F" Then
   For i = Val(T1) To Val(StrReverse(Mid(StrReverse(T1), 2, 2)))
      Z(Format(i, "00F")) = ""
   Next
   Else
      Q = Split(T1 & "&" & T1, "&")
      For i = 0 To UBound(Q)
         Z(Q(i)) = 0
      Next
End If
Brr = xBook.Sheets("Layout Dwg").UsedRange
For i = 2 To UBound(Brr)
   If Z.Exists(Brr(i, 2)) And Brr(i, 4) = Sheets("Read").[A2] Then
      Z(Brr(i, 1)) = Z(Brr(i, 1)) + Val(Brr(i, 3))
      N = N + 1
      For j = 1 To 4: Brr(N, j) = Brr(i, j): Next
      Z(Brr(N, 1) & "||") = 1
   End If
Next
If N > 0 Then Sheets("Layout Dwg").[A2].Resize(N, 4) = Brr: N = 0 Else MsgBox "Nothing under the floor": GoTo 12
Set Brr = xBook.Sheets("Frame per Dwg").UsedRange
Brr = Range(Brr, Brr.Offset(, 1))
For i = 2 To UBound(Brr)
   If Z(Brr(i, 1)) > 0 Then
      N = N + 1
      For j = 1 To 6: Brr(N, j) = Brr(i, j): Next
      Brr(N, 7) = Brr(N, 5) & " x " & Z(Brr(i, 1))
      Brr(N, 5) = Brr(N, 5) * Z(Brr(i, 1))
      Z(Brr(i, 2) & "/") = Z(Brr(i, 2) & "/") + Brr(N, 5)
      Z(Brr(i, 1) & "||") = Z(Brr(i, 1) & "||") + 1
   End If
Next
If N > 0 Then Sheets("Frame per Dwg").[A2].Resize(N, 7) = Brr: N = 0 Else MsgBox "Frame per Dwg_Nothing"
Brr = xBook.Sheets("Part List").UsedRange
ReDim Arr(1 To 100000, 1 To 14): Crr = Arr
For i = 2 To UBound(Brr)
   T = Brr(i, 8)
   If T Like "*[a-z]" Then Q = Left(T, Len(T) - 1) Else Q = "||"
   If Z(T & "||") = 1 Or Z(Q) > 0 Then
      N = N + 1
      For j = 1 To 13: Arr(N, j) = Brr(i, j): Next
      Arr(N, 14) = Arr(N, 3) & " x " & (Z(T) + Z(Q))
      Arr(N, 3) = Arr(N, 3) * (Z(T) + Z(Q))
   End If
   If Z(T & "/") > 0 And Z.Exists("|" & Left(T, 2)) Then
      R = R + 1
      For j = 1 To 13: Crr(R, j) = Brr(i, j): Next
      Crr(R, 14) = Crr(R, 3) & " x " & Z(T & "/")
      Crr(R, 3) = Crr(R, 3) * Z(T & "/")
   End If
Next
If N > 0 Then
   With Sheets("Part List").[A2].Resize(N, 14)
      .Value = Arr
      .Interior.ColorIndex = 35
   End With
End If
If R > 0 Then
   With Sheets("Part List").Cells(N + 2, 1).Resize(R, 14)
      .Value = Crr
      .Interior.ColorIndex = 36
   End With
End If
If N + R = 0 Then MsgBox "Part List_Nothing"
12: If Re = True Then xBook.Close 0
End Sub

198188

1. Sub Data()
   
2. Dim Arr, Brr, Crr, Z, Q, S, i&, j%, N&, T$, T1$, MyPath$, xFile$, xBook As Workbook, Re, R&
   
3. Dim rng, cell As Range
   
4. 
   
5. Application.ScreenUpdating = False
   
6. For Each S In [{"Layout Dwg","Frame per Dwg","Part List"}]
   
7.    Sheets(S).UsedRange.Rows.Offset(1).EntireRow.Delete
   
8.    'Delete Old data of "Layout Dwg","Frame per Dwg","Part List" from this workbook
   
9. Next
   
10. MyPath = ThisWorkbook.Path & "\"
    
11. xFile = "Data Base.xlsx"
    
12. On Error Resume Next
    
13. Set xBook = Workbooks(xFile)
    
14. If xBook Is Nothing Then
    
15.    Set xBook = Workbooks.Open(MyPath & xFile, , True, , "")
    
16.    Re = True: ThisWorkbook.Activate
    
17. End If
    
18. On Error GoTo 0
    
19. Set Z = CreateObject("Scripting.Dictionary")
    
20. T = Sheets("Read").[A2] & "|" & Sheets("Read").[C2]
    
21. T1 = Sheets("Read").[B2]
    
22. With xBook.Sheets("WO No")
    
23.    For i = 2 To .[A65536].End(3).Row
    
24.       If .Cells(i, "B") & "|" & .Cells(i, "D") = T Then
    
25.          .Rows(i).Copy Sheets("WO No").Rows(2)
    
26.          For j = 6 To 11
    
27.             Z("|" & .Cells(i, j)) = ""
    
28.             'Let Column F-K of WO No Sheet as KEY item and add "|" between each word then put into dictionary
    
29.          Next
    
30.          Sheets("Read").[A2].Resize(, 3).Copy Sheets("WO No").[B2]
    
31.          GoTo 11
    
32.       End If
    
33.    Next
    
34.    MsgBox "Nothing": Exit Sub
    
35. End With
    
36. 11
    
37. If T1 Like "##F-*##F" Then
    
38.    For i = Val(T1) To Val(StrReverse(Mid(StrReverse(T1), 2, 2)))
    
39.       Z(Format(i, "00F")) = ""
    
40.    Next
    
41.    Else
    
42.       Q = Split(T1 & "&" & T1, "&")
    
43.       For i = 0 To UBound(Q)
    
44.          Z(Q(i)) = 0
    
45.       Next
    
46. End If
    
47. Brr = xBook.Sheets("Layout Dwg").UsedRange
    
48. For i = 2 To UBound(Brr)
    
49.    If Z.Exists(Brr(i, 2)) And Brr(i, 4) = Sheets("Read").[A2] Then
    
50.       'If match of column B floor and column D batch
    
51.       Z(Brr(i, 1)) = Z(Brr(i, 1)) + Val(Brr(i, 3))
    
52.       'Sum of column C QTY of same of column A "Distribution Map No." of "Layout Dwg" (Name as:LDTotalQTY)
    
53.       N = N + 1
    
54.       For j = 1 To 4: Brr(N, j) = Brr(i, j): Next
    
55.    End If
    
56. Next
    
57. If N > 0 Then Sheets("Layout Dwg").[A2].Resize(N, 4) = Brr: N = 0 Else MsgBox "Nothing under the floor": GoTo 12
    
58. Brr = xBook.Sheets("Frame per Dwg").UsedRange
    
59. For i = 2 To UBound(Brr)
    
60.    If Z(Brr(i, 1)) > 0 Then
    
61.       N = N + 1
    
62.       For j = 1 To 6: Brr(N, j) = Brr(i, j): Next
    
63.       Brr(N, 5) = Brr(N, 5) * Z(Brr(i, 1))
    
64.       'Let Column E QTY of "Frame per Dwg" * LDTotalQTY
    
65.       If Z(Brr(i, 2)) > 0 Then
    
66.          MsgBox "*Layout Dwg* A column and *Frame per Dwg* B column are duplicate" & vbLf & vbLf & Brr(i, 2)
    
67.          Exit Sub
    
68.       End If
    
69.       Z(Brr(i, 2) & "/") = Z(Brr(i, 2) & "/") + Brr(N, 5)
    
70.       'Sum of Column E QTY of "Frame per Dwg" Column B "Assembly Drawing No." (Name as: FDTotalQTY)
    
71.    End If
    
72. Next
    
73. If N > 0 Then Sheets("Frame per Dwg").[A2].Resize(N, 6) = Brr: N = 0 Else MsgBox "Frame per Dwg_Nothing"
    
74. 
    
75. Brr = xBook.Sheets("Part List").UsedRange
    
76. ReDim Arr(1 To 100000, 1 To 13): Crr = Arr
    
77. For i = 2 To UBound(Brr)
    
78.    T = Brr(i, 8)
    
79.    
    
80.    If Z(T) > 0 Then
    
81.    Set rng = Sheets("Frame per Dwg").Columns("A:A")
    
82.    Set cell = rng.Find(What:=T, LookIn:=xlFormulas, _
    
83.                     LookAt:=xlWhole, MatchCase:=False)
    
84.    If cell Is Nothing Then
    
85.       N = N + 1
    
86.       For j = 1 To 13: Arr(N, j) = Brr(i, j): Next
    
87.       Arr(N, 3) = Arr(N, 3) * (Z(T) + Z(Q))
    
88.    End If
    
89.    End If
    
90.    '1.Filter Layout Dwg column A "Distribution Map No." of this workbook which don't appear on the Frame per Dwg of this workbook
    
91.    '1.1 Match of Layout Dwg column A "Distribution Map No." of this workbook and Part List column H "Distribution Map No." of Data Base workbook
    
92.    '1.2 If (1.) Match, list out the row on Part List of this workbook and column C QTY * LDTotalQTY
    
93.    '1.3 If the last word column H is lowercase letter of "Part List" of Data Base workbook, then remove the lowercase letter and match column A of "Layout Dwg" of this workbook, then list out the row on Part List of this workbook and column C QTY * LDTotalQTY
    
94.    If Z(T & "/") > 0 And Z.Exists("|" & Left(T, 2)) Then
    
95.       R = R + 1
    
96.       For j = 1 To 13: Crr(R, j) = Brr(i, j): Next
    
97.       Crr(R, 3) = Crr(R, 3) * Z(T & "/")
    
98.       '2. Column B "Assembly Drawing No." of "Frame per Dwg" of this workbook including column F-K of WO No, then match column H "Distribution Map No." of "Part List" of Data Base workbook
    
99.       '2.1 If (2.1) match, list out the row on Part List of this workbook and column C QTY * FDTotalQTY
    
100.    End If
     
101. Next
     
102. 
     
103. If Sheets("WO No").[F2] = "BW" Or Sheets("WO No").[F2] = "TW" Then
     
104. If N > 0 Then
     
105. 
     
106.    With Sheets("Part List").[A2].Resize(N, 13)
     
107.       .Value = Arr
     
108.       .Interior.ColorIndex = 35
     
109.       'Let Green which item list out by "Distribution Map No."
     
110.    End With
     
111. End If
     
112. Else
     
113. N = 0
     
114. End If
     
115. 
     
116. If R > 0 Then
     
117.    With Sheets("Part List").Cells(N + 2, 1).Resize(R, 13)
     
118.       .Value = Crr
     
119.       .Interior.ColorIndex = 36
     
120.       'Let Yellow which item list out by "Assembly Drawing No."
     
121.    End With
     
122. End If
     
123. If N + R = 0 Then MsgBox "Part List_Nothing"
     
124. 12: If Re = True Then xBook.Close 0
     
125. End Sub

½Æ»s¥N½X

¦^´_  198188


    Dataªº­×§ï¤è®×¤]´£¨Ñ°Ñ¦Ò:

Sub Data()
Dim Arr, Brr, Crr, Z, Q, S, i&, j%,  ...
Andy2483 µoªí©ó 2025-11-5 14:04

Part List ¼Æ¾Ú³W«h¦³¬õ¦â³¡¤À­×§ï¡G ªþ¤W­×§ïµ{¦¡½X

¥»ÀÉ WO No ªí¸ê®ÆÅã¥Ü³W«h¦p¤U¡G
1.¥»ÀɪºRead ªíªº A Äæ §å¦¸¦¸§Ç¡AB Äæ ¼Ó¼h ¡AC Äæ ¥Í²£³æ¸¹ ¤ñ¹ïData Base ÀÉùØ WO No ªíªº B Äæ §å¦¸¦¸§Ç,  C Äæ ¼Ó¼h ¤Î DÄæ ¥Í²£³æ¸¹
1.1 ­Y§k¦X®É¾ã¦C±a¥X¨Ó¨ì¥»ÀɪºWO No

¥»ÀÉ Layout Dwgªí¸ê®ÆÅã¥Ü³W«h¦p¤U¡G
1.¥»Àɪº WO No ªíªº C Äæ ¼Ó¼h ¤ñ¹ï Data Base ÀÉùØ Layout Dwg ªíªº B Äæ ¼Ó¼h
1.1 ­Y§k¦X®É, ¾ã¦C±a¥X¨Ó¨ì¥»ÀɪºWO No

¥»ÀÉFrame per Dwg ªí¸ê®ÆÅã¥Ü³W«h¦p¤U¡G
1. ¥»ÀɪºLayout Dwgªí ªºAÄæ ¤À§G¹Ï¸¹(¨äCÄæ¼Æ¶q (¬Û¦P¤À§G¹Ï¸¹) ­n¥[Á`,¥H¤UºÙ:LD¦X­p¼Æ¶q) ­n¤ñ¹ï Data Base ÀɸÌFrame per Dwg ªíªºAÄæ ¤À§G¹Ï¸¹
1.1 ­Y§k¦X®É, ¾ã¦C±a¥X¨Ó¨ì¥»ÀɪºFrame per Dwg,¨ä¤¤EÄ檺¼Æ¶q­n*LD¦X­p¼Æ¶q

¥»ÀÉPart List ªí¸ê®ÆÅã¥Ü³W«h¦p¤U¡G
1. ¥»Àɪº WO No ªíªº ¡§F2-K2¡¨Àx¦s®æ¬O ¡¨BW¡¨ or ¡§TW¡¨
1.1¥»ÀɪºLayout Dwgªí ªºAÄæ ¤À§G¹Ï¸¹ ­n¤ñ¹ï¥»ÀɪºFrame per Dwg ªíªºAÄæ ¤À§G¹Ï¸¹¡A¦pªG¨S¦³¦b¥»ÀɪºFrame per Dwg ªíùØ¥X²{
1.2 ­Y§k¦X®É, ¥»ÀɪºLayout Dwgªí ªºAÄæ ¤À§G¹Ï¸¹(¨äCÄæ¼Æ¶q(¬Û¦P¤À§G¹Ï¸¹)­n¥[Á`,¥H¤UºÙ:LD¦X­p¼Æ¶q) ­n¤ñ¹ï Data BaseÀÉ ¸ÌPart ListªíªºHÄæ ¤À§G¹Ï½s¸¹
1.3­Y§k¦X®É, ¾ã¦C±a¥X¨Ó¨ì¥»ÀɪºPart List,¨ä¤¤CÄ檺¼Æ¶q­n*LD¦X­p¼Æ¶q

2.1 ¥»Àɪº WO No ªíªº ¡§F2-K2¡¨Àx¦s®æ¤£¬O ¡¨BW¡¨ or ¡§TW¡¨
2.¥»ÀɪºFrame per Dwgªí ªºBÄæ ²Õ¸Ë¹Ï¸¹ (¨äEÄæ¼Æ¶q (¬Û¦P²Õ¸Ë¹Ï¸¹) ­n¥[Á`,¥H¤UºÙ:FD¦X­p¼Æ¶q) ¤]­n¤ñ¹ï Data BaseÀÉ ¸ÌPart ListªíªºHÄæ ¤À§G¹Ï½s¸¹
2.1 ­Y§k¦X®É, ¥»ÀɪºFrame per Dwgªí ªºBÄæ ²Õ¸Ë¹Ï¸¹ »Ý­n§t¦³ WO No ªíªº F - K Äæ ªº ¦r¥À
2.2.­Y§k¦X®É, ¾ã¦C¤]±a¥X¨Ó¨ì¥»ÀɪºPart List,¨ä¤¤CÄ檺¼Æ¶q­n*FD¦X­p¼Æ¶q

198188

¦^´_  198188


    FORM Åܧó¦p¤U:

Option Explicit
Public A, Z, R&, W, L, i&, Brr, Mrr, Q, Dr ...
Andy2483 µoªí©ó 2025-11-5 13:59

«e½ú¡A§Ú²×©ó¥i¥H°õ¦æForm¤F¡Aµo²{¦³³¡¤À°ÝÃD¡G

§Ú¥ý»¡3­Ó¤j¤è­±ªº°ÝÃD¡A内®e³¡¤Àµy«á¦A®Ö¹ï©M²ÓÁ¿¡G

1¡^ Form ¬O ®Ú¾Ú ¥»ÀÉ Part List ªº A Äæ ¥[¤u¥ó½s¸¹ ©M G Äæ ³Æª` ¨Ó¾É¥X Form
«e½úªºµ{¦¡¡A³s Frame per Dwg ¤]¾É¥X Form ¤F¡A³o³¡¤À¤£»Ý­n

2¡^Form ùØ­±¦³¤j¼ÐÃD, ½Ð¬Ý¥H¤U説©ú©Îªþ¥ó説©ú
BOM "A4" Àx¦s®æ¬O Ū¨ú Rule Äæ I ªº­^¤å¦WºÙ "BOM for Screw"
BOM "A5" Àx¦s®æ¬O Ū¨ú Rule Äæ J ªº¤¤¤å¦WºÙ "BOM for Á³µ·"
BOM "R3" Àx¦s®æ¬O ¹ïÀ³³Æª` Ū¨ú Rule Äæ B2-H2  ªº¤¤­^¤å¦WºÙ "Deliver to Site (Part) - ¤u¦a¦Û³Æ"

Gasket "D3" Àx¦s®æ¬O Ū¨ú Rule Äæ I ªº­^¤å¦WºÙ & "/" & Äæ J ªº¤¤¤å¦WºÙ "GASKET / ½¦±ø"
Gasket "D4" Àx¦s®æ¬O ¹ïÀ³³Æª` Ū¨ú Rule Äæ B2-H2  ªº¤¤­^¤å¦WºÙ "Deliver to Factory - ¼t©Ð¥Î"

Structural "C3" Àx¦s®æ¬O Ū¨ú Rule Äæ I ªº­^¤å¦WºÙ & "/" & Äæ J ªº¤¤¤å¦WºÙ " Structural Sealant / µ²ºc½¦"
Structural "C4" Àx¦s®æ¬O ¹ïÀ³³Æª` Ū¨ú Rule Äæ B2-H2  ªº¤¤­^¤å¦WºÙ " Deliver to Factory - ¼t©Ð¥Î"

DN Material "A3" Àx¦s®æ¬O ¹ïÀ³³Æª` Ū¨ú Rule Äæ B2-H2  ªº­^¤å¦WºÙ " Delivery Notes For Material Parts"
DN Material "A4" Àx¦s®æ¬O ¹ïÀ³³Æª` Ū¨ú Rule Äæ B2-H2  ªº¤¤¤å¦WºÙ  "´²¥ó¥X³f©ú²Ó"

Fabrication Extrusion "A3" Àx¦s®æ¬O ¹ïÀ³³Æª` Ū¨ú Rule Äæ B2-H2  ªº­^¤å¦WºÙ " Fabrication Order Sheet For Extrusion Parts"
Fabrication Extrusion "A4" Àx¦s®æ¬O ¹ïÀ³³Æª` Ū¨ú Rule Äæ B2-H2  ªº¤¤¤å¦WºÙ  "¥[¤u²M³æ"

Finish "A3" Àx¦s®æ¬O ¹ïÀ³³Æª` Ū¨ú Rule Äæ B2-H2 ªº­^¤å¦WºÙ "Finish Part Order On-Hold"  or "Finish Part Order"
Finish "A4" Àx¦s®æ¬O ¹ïÀ³³Æª` Ū¨ú Rule Äæ B2-H2ªº¤¤¤å¦WºÙ "¦¨«~³Æ¥Î"  or "¦¨«~¥X³f"

3¡^ ¥[¤u¥ó½s¸¹¬Û¦Pªº¯à§_¥u¥X²{¤@¦¸¡A¼Æ¶q´N¥[Á`¡C

198188

Part List ¼Æ¾Ú³W«h¦³¬õ¦â³¡¤À­×§ï¡G ªþ¤W­×§ïµ{¦¡½X

¥»ÀÉ WO No ªí¸ê®ÆÅã¥Ü³W«h¦p¤U¡G
1.¥»ÀɪºRe ...
198188 µoªí©ó 2025-11-5 14:38

«e½ú¦pªG¦b§¹¦¨¥H¤W ¥»ÀÉ Part List Ū¨ú«á¡A§Ú·Q¦A¥[¤@­Óµ{¦¡¡A­«½Æ¨â¹M¡C

1.        ¥»ÀÉPart  Listªíªº A Äæ ¥[¤u¥ó½s¸¹ ¤ñ¹ïData Base ÀÉùØ Part  List ªíªº H Äæ ¤À§G¹Ï¸¹¡A
1.1  ­Y§k¦X¡A, ¾ã¦C±a¥X¨Ó¨ì¥»ÀɪºPart List,¨ä¤¤CÄ檺¼Æ¶q­n * Data Base ÀɪºPart List ªºCÄ檺¼Æ¶q

§¹¦¨«á¡C

1.2 ¥»ÀÉPart  Listªíªº A Äæ ¥[¤u¥ó½s¸¹ ¤ñ¹ïData Base ÀÉùØ Part  List ªíªº H Äæ ¤À§G¹Ï¸¹¡A
1.3 ­Y§k¦X¡A, ¾ã¦C±a¥X¨Ó¨ì¥»ÀɪºPart List,¨ä¤¤CÄ檺¼Æ¶q­n * Data Base ÀɪºPart List ªºCÄ檺¼Æ¶q
§¹¦¨«á¡C

198188

¦^´_  198188


    PDFÀɲ£¥X¤è®×¦p¤U:

Option Explicit
Sub Print_PDF()
Dim T$, NewMyPath, Pj ...
Andy2483 µoªí©ó 2025-11-5 14:01

¤U¸ü (123.87 KB)

¬Q¤Ñ 16:02

³o­ÓPrint PDF ¬O§_©ñ¦b¥»ÀÉ¡A¾Þ§@ Form «á¡Aª½±µ¾Þ§@³o­ÓPrint PDF¡H »Ý­n¥ýÀx¦s Form ¥Í¦¨ªº Excel ¶Ü¡H
¥X²{¤F¹Ï¤ù³o­Ó°ÝÃD¡C

Andy2483

¦^´_ 157# 198188


1.½Ð±Ð«e½ú¡G ¥i¥H°õ¦æFom¬O«ç»ò³B²zªº¡H
2.ÁÙ­n­×§ïªºÅÞ¿è¬Ý°_¨Ó«ÜÅ¢²Î¡A¥i§_¥Î¦æ¸ÜÁ|¨Ò»¡©ú¬°¤°»ò­n§ï
3.«e½úªºµ{¦¡¡A³s Frame per Dwg ¤]¾É¥X Form ¤F¡A³o³¡¤À¤£»Ý­n¡H¡H
³o³¡¤À¬O¨Ì¾Ú«e½ú¤W¶Çªº ³W«h. docxÀɳ]­pªº¡A¦pªG­nÅܧó½Ð¦Û¦æ§R°£¦h¾lªº¥N½X