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

帖子: 26
主題: 3
精華: 0
積分: 34
點名: 0
作業系統: OSX
軟體版本: OSX
閱讀權限: 10
註冊時間: 2012-12-16
最後登錄: 2014-2-7

12^#

發表於 2012-12-20 16:34 | 只看該作者

回復 11# GBKEE
應該是：
發票編號_會員編號_會員名稱
INV12345_1122_周依霖.pdf (這發票成功列印及存檔)
但當另一位同事開新發票時，她又忘了更改發票編號只更新了會員資料但又直接列印及存檔
便會出現了相同的發票編號如下：
INV12345_1155_朱千雪.pdf
會員收費資料更新了，但是發票編號重複了
會員編號及會員名稱是會常常重複的，但發票編號不能重複，所以檔名能不能只針對發票編號不能重複作出提示

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

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

13^#

發表於 2012-12-20 17:02 | 只看該作者

回復 12# Blade

If Dir("存放資料夾全部路徑\" & "[發票編號]" & "*.pdf ") <> "" Then
MsgBox "發票編號已開出"
Exit Sub
End If

複製代碼

帖子: 26
主題: 3
精華: 0
積分: 34
點名: 0
作業系統: OSX
軟體版本: OSX
閱讀權限: 10
註冊時間: 2012-12-16
最後登錄: 2014-2-7

14^#

發表於 2012-12-20 23:09 | 只看該作者

回復 13# GBKEE

我加了在“紅色”那處，不能成功運作，我是否放錯位置或打錯甚麼？

      Option Explicit
Sub Print_and_SavePDF()
      Dim File_Name As String, xFile As String, xSNo As String, xName As String
      xFile = Range("D6")
      xSNo = Range("L7")             'xSNo 便是發票編號的位置
      xName = Range("M7")
            File_Name = xFile & "_" & xSNo & "_" & xName & ".pdf"
                              ActiveWorkbook.Save
ChDrive "D:\"
If Mid(CurDir, 1, 1) <> "d" Then ChDrive "d:\"
ChDir "d:\Account book\INV\"
If Dir("d:\Account book\INV\" & " xSNo " & "*.pdf ")<> "" Then
MsgBox "發票編號已開出"
Exit Sub
      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
End If
      Loop While Not UCase(File_Name) Like "*.PDF"
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFile & "_" & xSNo & "_" & xName & ".pdf", Quality:=xlQualityStandard _
      , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
      IgnorePrintAreas:=False
Range("N13").Select

End Sub

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

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

15^#

發表於 2012-12-21 06:23 | 只看該作者

本帖最後由 GBKEE 於 2012-12-22 07:19 編輯

回復 14# Blade

If Dir("d:\Account book\INV\*" & xSNo & "*.pdf ") <> "" Then

複製代碼

帖子: 26
主題: 3
精華: 0
積分: 34
點名: 0
作業系統: OSX
軟體版本: OSX
閱讀權限: 10
註冊時間: 2012-12-16
最後登錄: 2014-2-7

16^#

發表於 2012-12-21 13:54 | 只看該作者

回復 15# GBKEE
成功運行，但是重複發票編號沒有被提示

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

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

17^#

發表於 2012-12-21 14:07 | 只看該作者

本帖最後由 GBKEE 於 2012-12-22 07:20 編輯

回復 16# Blade

If Dir("d:\Account book\INV\*" & xSNo & "*.pdf ")<> "" Then
MsgBox "發票編號 "& xSNo&" 已開出"
Exit Sub

複製代碼

帖子: 26
主題: 3
精華: 0
積分: 34
點名: 0
作業系統: OSX
軟體版本: OSX
閱讀權限: 10
註冊時間: 2012-12-16
最後登錄: 2014-2-7

18^#

發表於 2012-12-21 16:49 | 只看該作者

回復 17# GBKEE
測試了幾次，依舊一樣，相同的發票編號可以重複存檔
INV12345_1122_周依霖.pdf
INV12345_1123_李子龍.pdf
INV12345_1124_朱正奇.pdf

感謝版大:D

由於發票編號是人打鍵入的，因此出錯是經常發生。
如果換另一個方式，加入自動編號，於儲存格內，即是每次另存新檔後，都會跳一個新的編號出來，便肯定不會出錯。

2012-12-21_164758.jpg (84.12 KB)

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

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

19^#

發表於 2012-12-21 17:06 | 只看該作者

回復 18# Blade
上傳存檔這工作表,是程式碼看看

帖子: 26
主題: 3
精華: 0
積分: 34
點名: 0
作業系統: OSX
軟體版本: OSX
閱讀權限: 10
註冊時間: 2012-12-16
最後登錄: 2014-2-7

20^#

發表於 2012-12-22 01:04 | 只看該作者

本帖最後由 Blade 於 2012-12-22 01:05 編輯

回復 19# GBKEE

Option Explicit
Sub 另存新檔測試()
Dim File_Name As String, xFile As String, xSNo As String, xName As String
xFile = Range("D6")
xSNo = Range("L7")
xName = Range("M7")
File_Name = xFile & "_" & xSNo & "_" & xName & ".pdf"
ActiveWorkbook.Save
ChDrive "D:\"
If Mid(CurDir, 1, 1) <> "d" Then ChDrive "d:\"
ChDir "d:\Account book\INV\"
If Dir("d:\Account book\INV\*" & " xSNo " & "*.pdf ") <> "" Then
MsgBox "發票編號 "& xSNo &" 已開出"
Exit Sub
End If
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 "*.PDF"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFile & "_" & xSNo & "_" & xName & ".pdf", Quality:=xlQualityStandard _
, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

複製代碼