- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
|
10#
發表於 2010-8-19 09:28
| 只看該作者
回復 9# PD961A
上則的程式碼,是要給你套用到Get_BardCode 中用的 ,你應該看的懂 哪只是部分的程式碼.
你沒有給程序名稱
Sub ????()
'
'
End Sub
- Sub Get_BardCode()
- Dim A As Range, d As Object, r%, k%, cnt%, i%, pnt%
- Set d = CreateObject("Scripting.Dictionary")
- With Sheet2
- For Each A In .[A1:D1]
- d(A.Value) = InputBox("請輸入" & A & "預設字元", "預設字元", IIf(A = .[C1], "", IIf(A = .[A1], "CC", Mid(A, 1, 1))))
- Next
- ay = d.items
- For Each A In .Range(.[A2], .[A65536].End(xlUp))
- A.Offset(, 4) = InputBox("請輸入第" & A.Row & "列" & A & "分裝量", "分裝量", 4)
- A.Offset(, 5) = IIf(A.Offset(, 1) Mod A.Offset(, 4) = 0, A.Offset(, 1) / A.Offset(, 4), Int(A.Offset(, 1) / A.Offset(, 4)) + 1)
- Next
- Sheet1.Range("B:C,F:G,J:K") = ""
- r = 2: k = 2
- kcnt = 1
- For Each A In .Range(.[A2], .[A65536].End(xlUp))
- AR = Array(A, A.Offset(, 4), A.Offset(, 2), A.Offset(, 3))
- cnt = 1
- Do Until cnt > A.Offset(, 5)
- If cnt = A.Offset(, 5) And A.Offset(, 1) Mod A.Offset(, 4) <> 0 Then
- AR(1) = A.Offset(, 1) - A.Offset(, 4) * (cnt - 1)
- End If
- Sheet1.Cells(r, k).Resize(4, 1).Value = Application.Transpose(AR)
- For i = 0 To UBound(AR)
- Sheet1.Cells(r + i, k + 1) = "*" & ay(i) & AR(i) & "*"
- Next
- r = IIf(r > 37, 2, IIf(k = 10, r + 5, r))
- k = IIf(r > 37 Or k = 10, 2, k + 4)
- If kcnt Mod 24 = 0 Or kcnt = Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then
- If pnt <> 6 Then Sheet1.PrintPreview '預覽
- If pnt = 0 Then pnt = MsgBox("是否列印" & Chr(10) & "是 列印" & Chr(10) & "否 預覽" & Chr(10) & "取消 離開", vbYesNoCancel)
- If pnt = 2 Then Exit Sub
- If pnt = 6 Then Sheet1.PrintOut '列印
- If kcnt < Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then Sheet1.Columns("B:C") = "": Sheet1.Columns("F:G") = "": Sheet1.Columns("J:K") = ""
- r = 2: k = 2
- End If
- kcnt = kcnt + 1
- cnt = cnt + 1
- Loop
- Next
- End With
- End Sub
複製代碼 |
|