寫一個另存新檔的巨集,但是需要.pdf file,那麼應怎改寫?
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2012-12-22 16:57 編輯
回復 24# Blade - 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
複製代碼- Sub 發票更新()
- Dim xSNo As Range, i As Integer, y As Integer, R As Integer, RR As Integer
- Set xSNo = Range("L7")
- y = Len(xSNo) '[發票編號]的字串個數
- For i = 1 To y
- If R = 0 And Mid(xSNo, i, 1) Like "[0-9]" Then R = i '找[發票編號]中第一個數字
- If Mid(xSNo, i, 1) Like "[!0-9]" Then RR = i '找[發票編號]中最後的文字
- Next
- If RR > R Or R = 0 Or xSNo = 0 Then '數字在文字之前(或只有文字),只有數字
- MsgBox " 發票有誤 !!!"
- Else
- xSNo = Mid(xSNo, 1, R - 1) & Format(Mid(xSNo,R) + 1, String((y - R + 1), "0"))
- End If
- '如 y - R + 1 = 5
- '如 :Format(568, String((y - R + 1), "0")) => Format(568, "00000") => 5位數: 00568
- End Sub
複製代碼 |
|
|
|
|
|
|
|