Board logo

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

作者: dechiuan999    時間: 2012-8-21 21:18     標題: 如何將A5紙張格式一次列印於A4紙張直接產生二份表格

各位大大好:

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

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

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

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

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

謝謝各位大大!
作者: luhpro    時間: 2012-8-22 21:28

各位大大好:
  小弟已完成一份表格,讓使用者可
由資料庫取出指定資料並填入表格內
的欄位位置。
   ...
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    時間: 2012-8-23 06:43

回復 2# luhpro


    大大您好:

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

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

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

感恩大大!
作者: GBKEE    時間: 2012-8-23 10:29

回復 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    時間: 2012-8-23 16:44

回復 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    時間: 2012-8-24 10:37

本帖最後由 GBKEE 於 2012-8-24 10:40 編輯

回復 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    時間: 2012-8-24 21:03

回復 6# GBKEE


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

就感心!!
感恩大大。




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