1234
返回列表 上一主題 發帖

寫一個另存新檔的巨集，但是需要.pdf file，那麼應怎改寫？

Blade

帖子
26 
主題
3 
精華
0 
積分
34 
點名
0  
作業系統
OSX 
軟體版本
OSX 
閱讀權限
10 
註冊時間
2012-12-16 
最後登錄
2014-2-7 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-12-16 18:41 | 只看該作者

寫一個另存新檔的巨集，但是需要.pdf file，那麼應怎改寫？

如果答“是”，正常運作，但是答“否”會跳到除錯模式，請問答”否“等如除消，怎麼編寫？

Sub SaveAS()
'
' 巨集1巨集
'
是否另存新檔 = InputBox("是否另存新檔? 是：Y, 否：N", , "Y")
File = Application.Range("D6")
Name = Application.Range("M7")
ActiveWorkbook.SaveAs Filename:=File & "-" & Name & ".xlsm"
     
End Sub
收藏 分享

kimbal

帖子
472 
主題
5 
精華
0 
積分
485 
點名
0  
作業系統
Windows 
軟體版本
MS Office 
閱讀權限
100 
性別
男 
來自
香港 
註冊時間
2010-7-4 
最後登錄
2014-12-28 

論壇貢獻勳章
2#
發表於 2012-12-16 19:47 | 只看該作者
回復 1# Blade
  1. Sub SaveAS()
  2. 是否另存新檔 = MsgBox("是否另存新檔?", vbYesNo)
  3. If 是否另存新檔 = vbYes Then
  4.     File = Application.Range("D6")
  5.     Name = Application.Range("M7")
  6.     ActiveWorkbook.SaveAS Filename:=File & "-" & Name & ".xlsm"
  7. End If
  8. End Sub
複製代碼
Excel 2010制作PDF
  1. Sub PrintPDF()
  2. 是否另存新檔 = MsgBox("是否用當前頁制作PDF?", vbYesNo)
  3. If 是否另存新檔 = vbYes Then
  4.     File = Application.Range("D6")
  5.     Name = Application.Range("M7")
  6.    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  7.         File & "-" & Name & ".pdf", Quality:=xlQualityStandard, _
  8.         IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  9. End If

  11. End Sub
複製代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

Blade

帖子
26 
主題
3 
精華
0 
積分
34 
點名
0  
作業系統
OSX 
軟體版本
OSX 
閱讀權限
10 
註冊時間
2012-12-16 
最後登錄
2014-2-7 
3#
發表於 2012-12-17 17:10 | 只看該作者
感謝！

另一個問題，如果檔案名稱已經存在，答"是"就如常蓋了舊的，但答"否"又怎寫呢？

2012-12-17_170134.jpg (11.11 KB)

2012-12-17_170134.jpg

2012-12-17_170049.jpg (10.49 KB)

2012-12-17_170049.jpg

TOP

Blade

帖子
26 
主題
3 
精華
0 
積分
34 
點名
0  
作業系統
OSX 
軟體版本
OSX 
閱讀權限
10 
註冊時間
2012-12-16 
最後登錄
2014-2-7 
4#
發表於 2012-12-17 22:46 | 只看該作者
回復 2# kimbal


    感謝！

另一個問題，如果檔案名稱已經存在，答"是"就如常蓋了舊的，但答"否"又怎寫呢？

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2012-12-18 11:12 | 只看該作者
回復 4# Blade
試試看
  1. Option Explicit
  2. Sub PrintPDF()
  3.     Dim File_Name As String, xFile As String, xName As String
  4.     xFile = Range("D6")
  5.     xName = Range("M7")
  6.     File_Name = xFile & "-" & xName & ".pdf"
  7.     Do
  8.         File_Name = InputBox("另存新檔", "[檔案存檔]", File_Name)
  9.         If File_Name = "" Then
  10.             Exit Sub
  11.         Else
  12.             If Dir(File_Name) <> "" Then
  13.                 If MsgBox("檔案名稱經存在,覆蓋它", vbYesNo) = vbYes Then
  14.                     Exit Do
  15.                 Else
  16.                     File_Name = ""
  17.                 End If
  18.             End If
  19.         End If        
  20.     Loop While Not UCase(File_Name) Like "*.PDF"
  21.    Application.DisplayAlerts = False
  22.    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  23.         xFile & "-" & xName & ".pdf", Quality:=xlQualityStandard, _
  24.         IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  25.     Application.DisplayAlerts = True
  26. End Sub
複製代碼

TOP

Blade

帖子
26 
主題
3 
精華
0 
積分
34 
點名
0  
作業系統
OSX 
軟體版本
OSX 
閱讀權限
10 
註冊時間
2012-12-16 
最後登錄
2014-2-7 
6#
發表於 2012-12-18 15:50 | 只看該作者
回復  Blade
試試看
GBKEE 發表於 2012-12-18 11:12


我現時的編碼是這樣
Sub SaveAS()
'
' Module2 Module
' invno
'

ActiveWorkbook.Save
是否另存新檔 = MsgBox("是否另存新檔?", vbYesNo)
If 是否另存新檔 = vbYes Then
File = Application.Range("D6")
SNo = Application.Range("L7")
Name = Application.Range("M7")
ChDir "D:\Account book\INV"
ActiveWorkbook.SaveAS Filename:=File & "_" & SNo & "_" & Name & ".xlsm"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=File & "_" & SNo & "_" & Name & ".pdf", Quality:=xlQualityStandard _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End If

End Sub

2012-12-18_154822.jpg (35.6 KB)

2012-12-18_154822.jpg

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2012-12-18 16:38 | 只看該作者
回復 6# Blade
有何問題嗎?

TOP

Blade

帖子
26 
主題
3 
精華
0 
積分
34 
點名
0  
作業系統
OSX 
軟體版本
OSX 
閱讀權限
10 
註冊時間
2012-12-16 
最後登錄
2014-2-7 
8#
發表於 2012-12-18 19:27 | 只看該作者
回復 7# GBKEE
感謝！成功了。

原檔名稱是inv.xlsm
當我完成資料時
如果我同時想留 "xlsm" & "pdf"
之後會有兩個檔案
INV11345-周依霖.xlsm
INV11345-周依霖.pdf

是否加入 "紅色的" ?

另外xName的x是否有意思的指示，用Name可以嗎？

        Option Explicit
    Sub PrintPDF()
        Dim File_Name As String, xFile As String, xName As String
        xFile = Range("D6")
        xName = Range("M7")
        File_Name = xFile & "-" & xName & ".xlsm"
        File_Name = xFile & "-" & xName & ".pdf"
        Do
            File_Name = InputBox("另存新檔", "[檔案存檔]", File_Name)
            If File_Name = "" Then
                Exit Sub
            Else
                If Dir(File_Name) <> "" Then
                    If MsgBox("檔案名稱經存在,覆蓋它", vbYesNo) = vbYes Then
                        Exit Do
                    Else
                        File_Name = ""
                    End If
                End If
            End If        
        Loop While Not UCase(File_Name) Like "*.xlsm"
        Loop While Not UCase(File_Name) Like "*.PDF"
       Application.DisplayAlerts = False
       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            xFile & "-" & xName & ".pdf", Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        Application.DisplayAlerts = True
    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兔年全勤獎章
9#
發表於 2012-12-19 07:49 | 只看該作者
回復 8# Blade
Name ,File  是VBA使用的關鍵字  變數,程序名稱要避免使用
  1. Option Explicit
  2. Sub PrintPDF()
  3.     Dim File_Name As String, xFile As String, xName As String
  4.     xFile = Range("D6")
  5.     xName = Range("M7")
  6.     File_Name = xFile & "-" & xName & ".xlsm"
  7.     'File_Name = xFile & "-" & xName & ".pdf"
  8.     Do
  9.         File_Name = InputBox("另存新檔", "[檔案存檔]", File_Name)
  10.         If File_Name = "" Then
  11.             Exit Sub
  12.         Else
  13.             If Dir(File_Name) <> "" Then
  14.                 If MsgBox("檔案名稱經存在,覆蓋它", vbYesNo) = vbYes Then
  15.                     Exit Do
  16.                 Else
  17.                     File_Name = ""
  18.                 End If
  19.             End If
  20.         End If
  21.     'Loop While Not UCase(File_Name) Like "*.XLSM"   'UCase(File_Name) 大寫 *.XLSM
  22.     Loop While Not LCase(File_Name) Like "*.xlsm"   'LCase(File_Name) 小寫 *.xlsm
  23.     Application.DisplayAlerts = False
  24.     ActiveWorkbook.SaveAs Filename:=File_Name
  25.     File_Name = Replace(LCase(File_Name), "*.xlsm", ".dbf")  '副檔名替換為 "dbf"
  26.     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  27.         xFile & "-" & xName & ".pdf", Quality:=xlQualityStandard, _
  28.         IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  29.     Application.DisplayAlerts = True
  30. End Sub
複製代碼

TOP

Blade

帖子
26 
主題
3 
精華
0 
積分
34 
點名
0  
作業系統
OSX 
軟體版本
OSX 
閱讀權限
10 
註冊時間
2012-12-16 
最後登錄
2014-2-7 
10#
發表於 2012-12-19 23:06 | 只看該作者
回復 9# GBKEE
感謝，十分成功。

我的INV File是放於D:\Account book\INV\INV.xlsm
我自行加下“紅色“的要求，但是另存.pdf後，file依然跑了去“我的文件”資料夾內，請問我是否放錯了指令的位置呢？

另一個問題，今天發現大頭蝦的同事，每次發invoice的時候，經常忘記更改invoice no，所以同一個invoice no經常出現於不同的客戶名稱裡。

每次發單時，另存後都是格式 INV12345_會員編號1_客戶名稱1.pdf
到了下一張單時，她又忘了更改INV12345，因此會出現 INV12345_會員編號2_客戶名稱2.pdf
請問有沒有指令方法，在另存時，只針對Invoice no的重複作提示

  'File_Name = xFile & "-" & xName & ".pdf"
ChDir "d:\Account book\INV\"
    Do
        File_Name = InputBox("另存新檔", "[檔案存檔]", File_Name)

TOP

        靜思自在 : 手心向下是助人，手心向上是求人；助人快樂，求人痛苦。
1234
返回列表 上一主題