返回列表 上一主題 發帖

[發問] excel vba 如何將其它程式的視窗移到最上層？

eigen

帖子
79 
主題
33 
精華
0 
積分
123 
點名
0  
作業系統
win7 
軟體版本
x64 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2013-10-24 
最後登錄
2024-3-28 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-10-28 17:54 | 顯示全部帖子

[發問] excel vba 如何將其它程式的視窗移到最上層？

本帖最後由 eigen 於 2016-10-28 17:57 編輯

這是一個列印的程式，會從 月結地址 抓指定的行，到 信封15K ，填入資料，然後從印表機列印。（又臭又長，我將這些省略了）

現在，我希望將這些，輸出成 pdf ，我的pc 有安裝  cutepdf ，列印時，然定cupte pdf  ，就能產生另新檔的畫面，就能產生pdf
  1. Sheets("信封15K").PrintOut Copies:=1, Collate:=True, ActivePrinter:="CutePDF Writer"    '指定cutePDF 列印   
  2. Application.Wait Now() + TimeValue("00:00:03")  'delay 3sec                                                
  3.                                                                                                             
  4. '如何讓 cutepdf 產生的 『另存新檔』的視窗出現在 最上面？                                                   
  5.                                                                                                             
  6. SendKeys "n", False                 'press n 跳到 檔名輸入樓位                                             
  7. SendKeys E.Range("B1") & ".Pdf" & "{ENTER}", False  'key in file name A001.pdf                              
複製代碼
delay 3sec 是因為 cupte pdf 的反應不快

出現另存新檔之後，我再用 SendKeys 這個指令來 輸入  n 及 輸入編號.pdf (a001.pdf b001.pdf之類）

後來實做時，400個地址大約要 27分鐘，在列印的期間，我只要操作電腦，（開啟 chrome/ word / 記事本..）  另存新檔 這個 視窗就會被擠到圖層的下面

這時的 key in 就會變成在 word / 記事本上打字 ，然後就....整個錯亂了

※我想在 key in 之前，能先將上圖的 『另存新檔』移到最上層，請問如何實作？謝謝
  1. Option Explicit
  2. Sub Print__15k()
  3. '******************************************************************
  4. '在Sheets("月結地址")中，用滑鼠選擇要印列的行，執行此程式，即可套表列印
  5. '******************************************************************
  6.     Dim E As Range
  7.       
  8.     Sheets("月結地址").Activate
  9.         For Each E In Selection.EntireRow
  10.         
  11.             If (E.Range("A1") = 1 Or UCase(E.Range("A1").Value) = "F") Then '排除第一行標頭 及 非準備列印的資料，行首需為1或F

  13.                 E.Range("a1") = "Yes"                   '標示 Yes，不同程序標示不一樣
  14.       
  15.         
  16.                 If Sheets("月結地址").AutoPDF.Value = False Then
  17.                     Sheets("信封15K").PrintOut              '印列
  18.                     Sheets("信封15K").Activate
  19.                 Else
  20.                     Sheets("信封15K").PrintOut Copies:=1, Collate:=True, ActivePrinter:="CutePDF Writer"    '指定cutePDF 列印
  21.                     Application.Wait Now() + TimeValue("00:00:03")  'delay 3sec
  22.                     
  23.                     '如何讓 cutepdf 產生的 『另存新檔』的視窗出現在 最上面？
  24.                     
  25.                     SendKeys "n", False                 'press n 跳到 檔名輸入樓位
  26.                     SendKeys E.Range("B1") & ".Pdf" & "{ENTER}", False  'key in file name A001.pdf
  27.                 End If
  28.                
  29.             'Else
  30.             '       MsgBox  "Input error!" & vbCrLf & vbCrLf & "Can't Print Cheque.", vbOKOnly, "Error"
  31.             End If
  32.         End If
  33.         
  34.         Next

  36. End Sub
複製代碼
收藏 分享
公開經驗，創造智慧（我又不靠這過活）

eigen

帖子
79 
主題
33 
精華
0 
積分
123 
點名
0  
作業系統
win7 
軟體版本
x64 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2013-10-24 
最後登錄
2024-3-28 
2#
發表於 2016-10-29 14:57 | 顯示全部帖子
回復 2# GBKEE

謝謝~~
  1. 'Option Explicit
  2. Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
  3. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
複製代碼
先宣告這兩個

改寫程式如下，下達列印指令之後，在for 迴圈等8次(時間可以自己調)， 找到『另存新檔』的視窗出現後立刻跳出for，

將 『另存新檔』 BringWindowToTop 移到最上層，輸入檔名

離開之後再等一秒（我發現cutepdf 的速度比 excel 慢，輸入完檔名，cutepdf 還沒完成工作，excel 已經抓完下一組的資料，在找『另存新檔』，導致順序錯亂）

※ 缺點：程式運作期間，不能操作電腦，不然一不小時就會影響譬另存新檔的輸入。

※我用過許多免費的 pdf ，目前就cutepdf 的輸出畫面最正常，窮則變，變則通~~

以上是 excel 2003 利用 vba 輸出一堆 pdf 的方法
  1. If Sheets("月結地址").AutoPDF.Value = False Then
  2.         Sheets("信封15K").PrintOut                      '印列
  3.         Sheets("信封15K").Activate
  4. Else
  5.         Sheets("信封15K").PrintOut Copies:=1, Collate:=True, ActivePrinter:="CutePDF Writer"
  6.         Application.Wait Now() + TimeValue("00:00:01")  'delay 1sec
  7.         Dim THandle As Long
  8.         Dim i  As Integer
  9.         For i = 1 To 8
  10.                 Application.Wait Now() + TimeValue("00:00:01")  'delay 1sec
  11.                 THandle = FindWindow(vbEmpty, "另存新檔")
  12.                 If THandle <> 0 Then
  13.                         i = 20
  14.                 End If
  15.         Next

  17.         If i = 20 + 1 Then
  18.                 BringWindowToTop THandle
  19.                 SendKeys "n", False                             'press n
  20.                 BringWindowToTop THandle
  21.                 SendKeys E.Range("B1") & "_" & E.Range("M1") & "_" & E.Range("C1") & ".Pdf" & "{ENTER}", False  'key in file name
  22.         End If
  23.         Application.Wait Now() + TimeValue("00:00:01")  'delay 1sec
  24. End If
複製代碼
公開經驗，創造智慧（我又不靠這過活）

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。
返回列表 上一主題