Board logo

標題: [發問] Bard code 列印問題 [打印本頁]
作者: PD961A    時間: 2010-8-18 10:07     標題: Bard code 列印問題

本帖最後由 PD961A 於 2010-8-19 07:32 編輯

請問先進
在"資料"工作表輸入所需條碼列印資料..
按下"列印鍵"原本可以自動計算並列印..
請問現在使用只剩單張資料顯示..程式碼是否有問題需要修正?....謝謝

[attach]2469[/attach]
作者: GBKEE    時間: 2010-8-18 17:10

回復 1# PD961A
修改了一下 請試試看
  1. Sub Get_BardCode()
  2.     Dim A As Range, d As Object, r%, k%, cnt%, i%, pnt%
  3.     Set d = CreateObject("Scripting.Dictionary")
  4.     With Sheet2
  5.         For Each A In .[A1:D1]
  6.             d(A.Value) = InputBox("請輸入" & A & "預設字元", "預設字元", IIf(A = .[C1], "", IIf(A = .[A1], "CC", Mid(A, 1, 1))))
  7.         Next
  8.         ay = d.items
  9.         For Each A In .Range(.[A2], .[A65536].End(xlUp))
  10.             A.Offset(, 4) = InputBox("請輸入第" & A.Row & "列" & A & "分裝量", "分裝量", 4)
  11.             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)
  12.         Next
  13.         Sheet1.Range("B:C,F:G,J:K") = ""
  14.         r = 2: k = 2
  15.         For Each A In .Range(.[A2], .[A65536].End(xlUp))
  16.             Ar = Array(A, A.Offset(, 4), A.Offset(, 2), A.Offset(, 3))
  17.             For cnt = 1 To A.Offset(, 5)
  18.                 With Sheet1.Cells(r, k).Resize(4, 1)
  19.                     .Value = Application.Transpose(Ar)
  20.                     For i = 0 To 3
  21.                         .Offset(, 1).Cells(i + 1) = "*" & ay(i) & Ar(i) & "*"
  22.                     Next
  23.                 End With
  24.                 k = k + 4
  25.                 If k > 10 Then k = 2:   r = r + 5
  26.             Next
  27.         Next
  28.     End With
  29.     pnt = MsgBox("是否列印" & Chr(10) & Chr(10) & "是    列印" & Chr(10) & "否    預覽" & Chr(10) & "取消 離開", vbYesNoCancel)
  30.     If pnt = 2 Then Exit Sub
  31.     If pnt = 6 Then Sheet1.PrintOut '列印
  32.     If pnt <> 6 Then Sheet1.PrintPreview '預覽
  33. End Sub
複製代碼
作者: PD961A    時間: 2010-8-18 17:31

回復 2# GBKEE


    版主
謝謝您
套用後...
它的計算功能...會沒有辦法將沒有整除的部份也當成是1張條碼格式

[attach]2474[/attach]

[attach]2475[/attach]
作者: PD961A    時間: 2010-8-18 17:38

本帖最後由 PD961A 於 2010-8-19 07:32 編輯

回復 2# GBKEE


    另外原程式--本來就沒有多下面這個小計那是臨時加上去的
     所以應該不是這裡不對...
    謝謝您....

[attach]2476[/attach]


[attach]2477[/attach]


[attach]2478[/attach]
作者: GBKEE    時間: 2010-8-18 18:48

回復 4# PD961A
寫程序時最好加上 Option Explicit 強制宣告變數  如圖 會自動加上
設立 變數 英文字不要太相似
少了一個k
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




    [attach]2484[/attach]
作者: GBKEE    時間: 2010-8-18 19:24

回復 3# PD961A
它的計算功能...會沒有辦法將沒有整除的部份也當成是1張條碼格式
最後一張 是要尾數嗎?
  1. AR = Array(A, A.Offset(, 4), A.Offset(, 2), A.Offset(, 3))
  2.     Do Until cnt > A.Offset(, 5)
  3.         If cnt = A.Offset(, 5) And A.Offset(, 1) Mod A.Offset(, 4) <> 0 Then
  4.             AR(1) = A.Offset(, 1) - A.Offset(, 4) * (cnt - 1)
  5.         End If
  6.         Sheet1.Cells(r, k).Resize(4, 1).Value = Application.Transpose(AR)
  7.         For i = 0 To UBound(AR)
  8.             Sheet1.Cells(r + i, k + 1) = "*" & ay(i) & AR(i) & "*"
  9.         Next
  10.         r = IIf(r > 37, 2, IIf(k = 10, r + 5, r))
  11.         k = IIf(r > 37 Or k = 10, 2, k + 4)
  12.         kcnt = kcnt + 1
  13.         If kcnt Mod 24 = 0 Or kcnt = Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then
  14.             If pnt <> 6 Then Sheet1.PrintPreview '預覽
  15.             If pnt = 0 Then pnt = MsgBox("是否列印" & Chr(10) & "是    列印" & Chr(10) & "否    預覽" & Chr(10) & "取消 離開", vbYesNoCancel)
  16.             If pnt = 2 Then Exit Sub
  17.             If pnt = 6 Then Sheet1.PrintOut '列印
  18.             If kcnt < Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then Sheet1.Columns("B:C") = "": Sheet1.Columns("F:G") = "": Sheet1.Columns("J:K") = ""
  19.             r = 2: k = 2
  20.         End If
  21.         cnt = cnt + 1
  22.     Loop
複製代碼
作者: PD961A    時間: 2010-8-19 07:22

回復 6# GBKEE


    謝謝版主
沒錯..是要尾數也計算出成1張
10KG=2張4KG+1張2KG

謝謝您

[attach]2489[/attach]
作者: GBKEE    時間: 2010-8-19 07:54

本帖最後由 GBKEE 於 2010-8-19 07:57 編輯

回復 7# PD961A
這些程式碼 就是判斷最後一張是否是整數
03.        If cnt = A.Offset(, 5) And A.Offset(, 1) Mod A.Offset(, 4) <> 0 Then
04.            AR(1) = A.Offset(, 1) - A.Offset(, 4) * (cnt - 1)
05.        End If
附圖 是什麼問題
作者: PD961A    時間: 2010-8-19 08:23

本帖最後由 PD961A 於 2010-8-19 09:34 編輯

回復 8# GBKEE


    把您的程式碼帶進去了...
得到就是這樣的畫面....
作者: GBKEE    時間: 2010-8-19 09:28

回復 9# PD961A
上則的程式碼,是要給你套用到Get_BardCode 中用的 ,你應該看的懂 哪只是部分的程式碼.
你沒有給程序名稱
Sub ????()   
'
'
End Sub
  1. Sub Get_BardCode()
  2.     Dim A As Range, d As Object, r%, k%, cnt%, i%, pnt%
  3.     Set d = CreateObject("Scripting.Dictionary")
  4.     With Sheet2
  5.         For Each A In .[A1:D1]
  6.             d(A.Value) = InputBox("請輸入" & A & "預設字元", "預設字元", IIf(A = .[C1], "", IIf(A = .[A1], "CC", Mid(A, 1, 1))))
  7.         Next
  8.         ay = d.items
  9.         For Each A In .Range(.[A2], .[A65536].End(xlUp))
  10.             A.Offset(, 4) = InputBox("請輸入第" & A.Row & "列" & A & "分裝量", "分裝量", 4)
  11.             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)
  12.         Next
  13.         Sheet1.Range("B:C,F:G,J:K") = ""
  14.         r = 2: k = 2
  15.         kcnt = 1
  16.         For Each A In .Range(.[A2], .[A65536].End(xlUp))
  17.            AR = Array(A, A.Offset(, 4), A.Offset(, 2), A.Offset(, 3))
  18.             cnt = 1
  19.             Do Until cnt > A.Offset(, 5)
  20.                 If cnt = A.Offset(, 5) And A.Offset(, 1) Mod A.Offset(, 4) <> 0 Then
  21.                     AR(1) = A.Offset(, 1) - A.Offset(, 4) * (cnt - 1)
  22.                 End If
  23.                 Sheet1.Cells(r, k).Resize(4, 1).Value = Application.Transpose(AR)
  24.                 For i = 0 To UBound(AR)
  25.                     Sheet1.Cells(r + i, k + 1) = "*" & ay(i) & AR(i) & "*"
  26.                 Next
  27.                 r = IIf(r > 37, 2, IIf(k = 10, r + 5, r))
  28.                 k = IIf(r > 37 Or k = 10, 2, k + 4)
  29.                 If kcnt Mod 24 = 0 Or kcnt = Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then
  30.                     If pnt <> 6 Then Sheet1.PrintPreview '預覽
  31.                     If pnt = 0 Then pnt = MsgBox("是否列印" & Chr(10) & "是    列印" & Chr(10) & "否    預覽" & Chr(10) & "取消 離開", vbYesNoCancel)
  32.                     If pnt = 2 Then Exit Sub
  33.                     If pnt = 6 Then Sheet1.PrintOut '列印
  34.                     If kcnt < Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then Sheet1.Columns("B:C") = "": Sheet1.Columns("F:G") = "": Sheet1.Columns("J:K") = ""
  35.                     r = 2: k = 2
  36.                 End If
  37.                 kcnt = kcnt + 1
  38.                 cnt = cnt + 1
  39.             Loop
  40.         Next
  41.     End With
  42. End Sub
複製代碼
作者: PD961A    時間: 2010-8-19 09:42

回復 10# GBKEE


    版主
對不起啦...真的沒注意到
謝謝您這麼耐心的說明
2個檔案都改好
也都可以用了....
謝謝您...



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)