- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# PD961A
修改了一下 請試試看- 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
- For Each A In .Range(.[A2], .[A65536].End(xlUp))
- Ar = Array(A, A.Offset(, 4), A.Offset(, 2), A.Offset(, 3))
- For cnt = 1 To A.Offset(, 5)
- With Sheet1.Cells(r, k).Resize(4, 1)
- .Value = Application.Transpose(Ar)
- For i = 0 To 3
- .Offset(, 1).Cells(i + 1) = "*" & ay(i) & Ar(i) & "*"
- Next
- End With
- k = k + 4
- If k > 10 Then k = 2: r = r + 5
- Next
- Next
- End With
- pnt = MsgBox("是否列印" & Chr(10) & Chr(10) & "是 列印" & Chr(10) & "否 預覽" & Chr(10) & "取消 離開", vbYesNoCancel)
- If pnt = 2 Then Exit Sub
- If pnt = 6 Then Sheet1.PrintOut '列印
- If pnt <> 6 Then Sheet1.PrintPreview '預覽
- End Sub
|
|
發表於 2010-8-18 17:10
| 