EXCEL 合併列印 二、範例、華南銀行存款憑條

excel_auto_print  

http://aney22.pixnet.net/blog/post/45694645
EXCEL 合併列印 套板列印進階教學 step by step 用點陣印表

http://aney22.pixnet.net/blog/post/45709522
EXCEL 合併列印二、範例、華南銀行存款憑條

http://aney22.pixnet.net/blog/post/47885190
EXCEL 自動化 列印喜帖 列印信封

http://aney22.pixnet.net/blog/post/47880666
EXCEL 自動化 大宗郵件存根2聯單 交寄大宗限時掛號及掛號函件

http://aney22.pixnet.net/blog/post/48324846
EXCEL 合併列印 套表列印 郵局貼紙寄件單

 

一、下載範列：ExcelAutoPrint.zip(Google driver)

 (請點Google Drive 上方的下載，直接下載，不要來和我要什麼存取權）


二、樣板排版技巧：請參考

EXCEL 合併列印一、：套板列印排版教學
http://aney22.pixnet.net/blog/post/45694645

這個例子，我約兩個小時完成排版，巨集部份則是 copy/paste，很快就搞定

 

三、巨集介紹：在excel ，按下Ctrl+F11 可以進入巨集編輯器。（excel 合併列印最大的門檻，看過就會了，真的不難）

excel_auto_print

螢幕截圖 2015-12-26 23.07.35  

ThisWorkbook:

 
'設定快速鍵取啟動巨集 PrintVBA
Private Sub Workbook_Open()
        Application.OnKey "^b", "PrintVBA"
End Sub
'存檔時，能以時間命名檔案
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
        Cancel As Boolean)
        
        Dim filename As String
        Dim a As Integer
        a = MsgBox("Do you want to save with DateTime?", vbYesNo + vbQuestion + vbDefaultButton2, "Upate filename?")
        If a = vbYes Then
                filename = "_存款憑條_" & Format(Now, "YYYYMMDD_HHMMSS_")       'save as _存款憑條_20131115_100754.xls
                Application.EnableEvents = False                                '關閉 Workbook_BeforeSave，避免發生重複觸發
                Application.Dialogs(xlDialogSaveAs).Show (filename)
                Application.EnableEvents = True
                Cancel = True
        End If
End Sub
 
 

  

 

模組->Module

'
'合併列印巨集程式
Option Explicit
Sub PrintVBA()
        '**********************************************
        '在Sheets("List")中滑鼠選擇要印列的『列』 ,執行此程式
        '**********************************************
        Dim E As Range
        Dim ID As String
        
        Sheets("List").Activate                                                         '切換Sheet
                For Each E In Selection.EntireRow                                       'For loop
        
                        If E.Row > 1 And E.Range("a1") = 1 And Application.CountA(E.Range("A1:F1")) = 6 Then    '例外排除，第一列不處理、第一格必需為1，六格必需要填滿。
        
                                With Sheets("PrintPage")
 
                                        ID = Right("00000000000000" & E.Range("D1"), 12)                        '帳號補零，從右取12位數。
                                        .[C3] = Mid(ID, 1, 1) & " " & _
                                                        Mid(ID, 2, 1) & " " & _
                                                        Mid(ID, 3, 1) & " " & _
                                                        Mid(ID, 4, 1) & " " & _
                                                        Mid(ID, 5, 1) & " " & _
                                                        Mid(ID, 6, 1) & " " & _
                                                        Mid(ID, 7, 1) & " " & _
                                                        Mid(ID, 8, 1) & " " & _
                                                        Mid(ID, 9, 1) & " " & _
                                                        Mid(ID, 10, 1) & " " & _
                                                        Mid(ID, 11, 1) & " " & _
                                                        Mid(ID, 12, 1)                                          '在帳號中插入空格，以便『分散對齊』
 
'                                       .[B5] = E.Range("C1")                           '姓名                   'copy 姓名
                                        .[G3] = E.Range("F1")                           '年月日                 'copy 年月日
                                        .[D6] = E.Range("E1")                           '金額                   'copy 金額
                                       
                                        E.Range("A1") = "OK"                                                    '將開關改填 ok ，確認處理過
                                        .PrintOut                                       '印列
                                End With
'                       Else
'                               MsgBox  "Input error!" & vbCrLf & vbCrLf & "Can't Print Cheque.", vbOKOnly, "Error"
                       End If
 
                
                Next
 
End Sub
 
 
 
'數字小寫轉國字大寫巨集
Function exchange(ByVal Myinput)
 
        Dim Temp, MyinputA, MyinputB, MyinputC
        Dim Place As String
        Dim J As Integer
        Dim integer1, integer2 As String
        Dim digitvalue As String
        Dim digitlength As Integer
 
 
        Place = "分角元拾佰仟萬拾佰仟億拾佰仟萬"
        integer1 = "壹貳參肆伍陸柒捌玖"
        integer2 = "整零元零零零萬零零零億零零零萬"
        digitvalue = ""
 
        If Myinput < 0 Then digitvalue = "負"
                Myinput = Int(Abs(Myinput) * 100 + 0.5)
                If Myinput > 999999999999999# Then
                        exchange = "數字太大了！"
                        Exit Function
                End If
                If Myinput = 0 Then
                        exchange = "零元零分"
                Exit Function
        End If
 
        MyinputA = Trim(Str(Myinput))
        digitlength = Len(MyinputA)
        For J = 1 To digitlength
                MyinputB = Mid(MyinputA, J, 1) & MyinputB
        Next
        For J = 1 To digitlength
                Temp = Val(Mid(MyinputB, J, 1))
                If Temp = 0 Then
                        MyinputC = Mid(integer2, J, 1) & MyinputC
                Else
                        MyinputC = Mid(integer1, Temp, 1) & Mid(Place, J, 1) & MyinputC
                End If
        Next
 
        digitlength = Len(MyinputC)
        For J = 1 To digitlength - 1
                If Mid(MyinputC, J, 1) = "零" Then
                        Select Case Mid(MyinputC, J + 1, 1)
                                Case "零", "元", "萬", "億", "整":
                                MyinputC = Left(MyinputC, J - 1) & Mid(MyinputC, J + 1, 30)
                                J = J - 1
                        End Select
                End If
        Next
 
        digitlength = Len(MyinputC)
        For J = 1 To digitlength - 1
                If Mid(MyinputC, J, 1) = "億" And Mid(MyinputC, J + 1, 1) = "萬" Then
                        MyinputC = Left(MyinputC, J) & Mid(MyinputC, J + 2, 30)
                        Exit For
                End If
        Next
 
        exchange = digitvalue & Trim(MyinputC)
 
End Function
 
 

 

四、檔名預設是 *.xlT ，以Template 方式命名，開啟時不會影響到原始檔案。

 

五、利用 Workbook_BeforeSave 存檔時，預設不會更新時間命名。必要時，則可以在檔名加上時間。

 

六、數字小寫轉國字大寫巨集，來自網路，我也不知道最原始的出處。感謝網路諸位大德

 

七、PrintVBA，可以在選定的列，可以選一行或多行，按下Ctrl+B 即可執行。

程式本身會檢查是否在第一行，是否有設定列印，是否六格必要資料都有填寫。然後執行複制的動作，最後列印出來。

Excel VBA技術出處：麻辣家族討論版

 


八、已知缺點：

缺點一、無法設定設表機。（需要先設定好印表機才能連續列印）

我有五台印表機，預設的印表機是 CutePDF，適合列印的機器並不是預設那台，因此在第一次列印時，我都會讓程序先印一行，取消 PDF

然後在PrintPage 點選列印，選擇適合的印表機，列印。之後再回 List ，Ctrl+B ，快速列印。

或著，你可以先在 PrintPage 點選列印，選擇印表機後，選擇『取消』離開。（列印的印表機已改成你所選擇）再回到 List ，Ctrl+B ，快速列印。


缺點二、修改巨集後，在巨集畫面下，無法存檔成功，需關閉巨集編輯軟體，在excel 畫面下存檔才會成功。（不修改巨集是不受影響）

 

 

 

 

 

2016/1/20 上午 12:25:29 補充

數字小寫轉國字大寫巨集
E4=TEXT(D6,"[dbnum2]")&"元整"
E4=TEXT(D6,"[dbnum2]0億0千0佰0拾0萬0千0佰0拾0元")
E4=TEXT(D6,"[dbnum2]0 0 0 0 0 0 0 0 0")

拾荒老人發現一個microsoft 隱藏的公式，可以直接顯示大寫數字

DBnum1 /DBnum2

原本的在 E4= exchange(d6)

可以直接用 E4=TEXT(D6,"[dbnum2]")&"元整"

用在統一發票上，只打大寫國字不打 拾佰仟萬，可以用

E4=TEXT(D6,"[dbnum2]0 0 0 0 0 0 0 0 0")

 

第一章，EXCEL 合併列印 套板列印進階教學 step by step 用點陣印表機，打印手寫統一發票

第二章，EXCEL 合併列印二、範例、華南銀行存款憑條

第三章：EXCEL 自動化 大宗郵件存根2聯單 交寄大宗限時掛號及掛號函件執據存根2聯單

 

 

 

 

 

 

arrow
arrow
    全站熱搜

    aney22 發表在 痞客邦 留言(1) 人氣()

    E-mail轉寄