返回列表 上一主題 發帖

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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
複製代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼

TOP

        靜思自在 : 站在半路，比走到目標更辛苦。
返回列表 上一主題