帖子: 231
主題: 55
精華: 0
積分: 293
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: KEELUNG
註冊時間: 2010-7-24
最後登錄: 2018-8-28

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2012-8-21 21:18 | 只看該作者

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

各位大大好：

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

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

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

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

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

謝謝各位大大！

PRINTTEST.rar (11.11 KB)

樓主熱帖

luhpro

高中生 Rank: 3 Rank: 3

帖子: 824
主題: 6
精華: 0
積分: 904
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2023-12-24

2^#

發表於 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. 列印完請記得將相關參數還原

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

TOP

dechiuan999

中學生 Rank: 2

帖子: 231
主題: 55
精華: 0
積分: 293
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: KEELUNG
註冊時間: 2010-7-24
最後登錄: 2018-8-28

3^#

發表於 2012-8-23 06:43 | 只看該作者

回復 2# luhpro

大大您好：

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

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

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

感恩大大！

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2012-8-23 10:29 | 只看該作者

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

Option Explicit
Dim Sh As Worksheet, Rng As Range
Sub 按鈕() '按紐指定的程式
Dim 印列 As String
Set Sh = ActiveSheet
Set Rng = Sh.[A1:G20] '表格範圍
Do
印列 = InputBox("印列表格: 請輸入 1 或 2 ", "印列表格")
Loop Until 印列 = "1" Or 印列 = "2" Or 印列 = ""
If 印列 = "1" Then
With Sh
.PageSetup.PrintArea = Rng.Address
.PageSetup.FitToPagesTall = 1
.PageSetup.FitToPagesWide = 1
.PrintOut
End With
ElseIf 印列 = "2" Then
二張表格
End If
End Sub
Private Sub 二張表格()
Dim R As Range, ActionShape As String, i As Integer
With Sh
ActionShape = .Shapes(Application.Caller).Name '執行此程式的按鈕名稱
'---此行程式碼按F5 或 F8 會有錯誤需是在工作表按下 [按鈕] 執行 ----
Application.ScreenUpdating = False
Rng.Copy Rng.Offset(Rng.Rows.Count) '複製表格
For Each R In Rng.Rows '
R.Offset(20).RowHeight = R.RowHeight '複製表格:調整列高與表格相同
Next
.PageSetup.PrintArea = .Range(Rng, Rng.Offset(Rng.Rows.Count)).Address
'設定印列範圍
.PageSetup.FitToPagesTall = 1
.PageSetup.FitToPagesWide = 1
'.PrintPreview '印列預覽
.PrintOut '印列
For i = .Shapes.Count To 2 Step -1 '刪除圖片:片由後刪除到第2個
If .Shapes(i).Name <> ActionShape Then .Shapes(i).Delete
'排除Shape是指定程式按紐的Shape
Next
Rng.Offset(Rng.Rows.Count).Clear '清除: 複製表格
Rng.Offset(Rng.Rows.Count).RowHeight = .Cells(.Rows.Count).RowHeight
'回復列高
.PageSetup.PrintArea = Rng.Address '回復印列範圍
Application.ScreenUpdating = True
End With
End Sub

複製代碼

TOP

dechiuan999

中學生 Rank: 2

帖子: 231
主題: 55
精華: 0
積分: 293
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: KEELUNG
註冊時間: 2010-7-24
最後登錄: 2018-8-28

5^#

發表於 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

感恩大大！！

TOP

GBKEE