[發問] 如何將A5紙張格式一次列印於A4紙張直接產生二份表格

dechiuan999

各位大大好：

  小弟已完成一份表格，讓使用者可
由資料庫取出指定資料並填入表格內
的欄位位置。
  此表格預設可列印 A5紙張，由於
須印此表格為一式二份，又公司影印機
卡夾內為 A4 紙張；正好符合 A5 X 2= A4
但小弟一直無法以一份表格直接在 A4 紙張
印出此表格為二份。
  小弟想請問此情形是否須符合下列那一
種方法才可逹成上述的須求。

一、可在版面設定來逹成一張A4紙
    直接印列成二份表格

二、先完成此份表格再複製至另一工作表
    連續複製二次來逹成列印於A4紙張
    逹成印成二份表格

三、先在此工作表製成二份空白表格，將
    由資料庫取出的資料完成填入一份表格
    內，並於列印時再將第一份表格的
    資料填入另一份空白的表格內在一起列印

如是第一種方式時應如何設定，
如是第二、三種方式時VBA語法又如何
設計呢？

謝謝各位大大！

luhpro

各位大大好：
  小弟已完成一份表格，讓使用者可
由資料庫取出指定資料並填入表格內
的欄位位置。
   ...
dechiuan999 發表於 2012-8-21 21:18

我剛剛有想到一種方式: (請依現況酌予修改下述內容)
1. 將要列印的兩頁資料放在一起.
2. 設定要列印的區域範圍:

Worksheets("Sheet1").PageSetup.PrintArea = "$A$1:$C$5"

3. 設定列印成 1 頁高 1 頁寬.

With Worksheets("Sheet1").PageSetup
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With

4. 列印完請記得將相關參數還原

這樣應該就可以達到你想要的效果了.

dechiuan999

回復 2# luhpro


    大大您好：

謝謝您的說明
您有提到
1. 將要列印的兩頁資料放在一起.
2. 設定要列印的區域範圍:
其實小弟在工作表上顯示二個
要列印的表格，是不知要如何排除另一個
表格。就能同時在一張A4紙直接列
印出二份表格出來。讓使用者也不會
感覺有多出一份表格。

小弟昨天先以新增一工作表，
並在該表上增設二份表格。
等到該使用者要填的表格
完成填寫之後，再設定一按鈕
讓使用者列印，同時也將使用者的
填寫表格資料再轉寫至新增的二份表格內
完成列印工作。

小弟是希望能減少上述的一些步驟。

感恩大大！

GBKEE

回復 3# dechiuan999
依1#附檔 第一個表格所寫, 試試看

1. Option Explicit
   
2. Dim Sh As Worksheet, Rng As Range
   
3. Sub 按鈕()       '按紐指定的程式
   
4.     Dim 印列 As String
   
5.     Set Sh = ActiveSheet
   
6.     Set Rng = Sh.[A1:G20]                            '表格範圍
   
7.     Do
   
8.         印列 = InputBox("印列表格:  請輸入  1 或 2 ", "印列表格")
   
9.     Loop Until 印列 = "1" Or 印列 = "2" Or 印列 = ""
   
10.     If 印列 = "1" Then
    
11.         With Sh
    
12.             .PageSetup.PrintArea = Rng.Address
    
13.             .PageSetup.FitToPagesTall = 1
    
14.             .PageSetup.FitToPagesWide = 1
    
15.             .PrintOut
    
16.         End With
    
17.     ElseIf 印列 = "2" Then
    
18.         二張表格
    
19.     End If
    
20. End Sub
    
21. Private Sub 二張表格()
    
22.     Dim R As Range, ActionShape As String, i As Integer
    
23.     With Sh
    
24.         ActionShape = .Shapes(Application.Caller).Name  '執行此程式的按鈕名稱
    
25.         '---此行程式碼 按F5 或 F8 會有錯誤  需是在工作表按下 [按鈕] 執行 ----
    
26.         Application.ScreenUpdating = False
    
27.         Rng.Copy Rng.Offset(Rng.Rows.Count)             '複製表格
    
28.         For Each R In Rng.Rows            '
    
29.             R.Offset(20).RowHeight = R.RowHeight        '複製表格:調整列高與表格 相同
    
30.         Next
    
31.         .PageSetup.PrintArea = .Range(Rng, Rng.Offset(Rng.Rows.Count)).Address
    
32.                                                         '設定印列範圍
    
33.         .PageSetup.FitToPagesTall = 1
    
34.         .PageSetup.FitToPagesWide = 1
    
35.         '.PrintPreview                                  '印列預覽
    
36.         .PrintOut                                       '印列
    
37.         For i = .Shapes.Count To 2 Step -1              '刪除圖片:片由後刪除到第2個
    
38.             If .Shapes(i).Name <> ActionShape Then .Shapes(i).Delete
    
39.                                                         '排除Shape是指定程式按紐的Shape
    
40.         Next
    
41.         Rng.Offset(Rng.Rows.Count).Clear                '清除: 複製表格
    
42.         Rng.Offset(Rng.Rows.Count).RowHeight = .Cells(.Rows.Count).RowHeight
    
43.                                                         '回復列高
    
44.         .PageSetup.PrintArea = Rng.Address              '回復印列範圍
    
45.         Application.ScreenUpdating = True
    
46.     End With
    
47. End Sub

複製代碼

dechiuan999

回復 4# GBKEE


    版主大大您好：

   感謝您的相助，此方法實在
太完美。唯獨有一語法小弟也
上網找了很多範例說明
Application.Caller之用法
卻仍無法領會，網路上的範例
也不知如何執行。
想 請版主大大能開示指點迷津
application caller之應用
及其含意為何？

版主語法如下：
ActionShape = .Shapes(Application.Caller).Name  '執行此程式的按鈕名稱

網路上的範例：
Function Sheetname()
       Application.Volatile
       Sheetname = Application.Caller.Parent.Name
End Function

Function Test()

      Application.Volatile
      ' Returns the cell one column to the left of the active cell. Note
      ' that the active cell is not necessarily the cell that is calling
      ' the function.
      Test = ActiveCell.Offset(0, -1).Value
   End Function

change it to the following:

   Function Test()
      Application.Volatile
      ' Returns the cell one column to the left of the cell that is
      ' actually calling the function.
      Test = Application.Caller.Offset(0, -1).Value
   End Function

感恩大大！！

GBKEE

回復 5# dechiuan999
Caller 屬性  傳回關於呼叫 Visual Basic 的資訊 。
請在工作表上設一物件(圖片, 按鈕...) 巨集指向 Ex_Caller
一般模組的程式碼

1. Option Explicit
   
2. Sub Ex_Caller()
   
3. The_Caller Application.Caller
   
4. End Sub
   
5. Sub Auto_Open() '存檔後: 開檔時自動啟動的巨集
   
6. The_Caller "Auto_Open"
   
7. End Sub
   
8. Sub Auto_CLOSE() '關檔時自動啟動的巨集
   
9. The_Caller "Auto_CLOSE"
   
10. End Sub
    
11. Function Ex() As String '工作表上 輸入函數 =Ex()
    
12. Application.Volatile '(Ex") = False
    
13. Ex = "Ex_Function"
    
14. The_Caller "Function Ex()"
    
15. End Function
    
16. Sub The_Caller(Macro As String)
    
17. Dim v As String
    
18. Select Case TypeName(Application.Caller)
    
19. Case "Range"
    
20. '在單一儲存格中輸入的自訂函數
    
21. v = Application.Caller.Address
    
22. Case "String" '--傳回乎叫此巨集的物名稱 ---
    
23. 'Auto_Open、Auto_Close、Auto_Activate 或 Auto_Deactivate 巨集
    
24. v = Application.Caller
    
25. Case "Error"
    
26. '[工具] 功能表中的 [巨集] 對話方塊，或上述之外的其他呼叫者 #REF! 錯誤值
    
27. v = "Error"
    
28. Case Else
    
29. v = "unknown"
    
30. End Select
    
31. MsgBox Macro & Chr(10) & "Caller = " & v
    
32. End Sub

複製代碼

dechiuan999

回復 6# GBKEE


    感謝版主大大
提供諸多範例。
  小弟會利用週末的時間
用心學習相關範例的變化。

就感心！！
感恩大大。