返回列表 上一主題 發帖

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

本帖最後由 GBKEE 於 2012-12-22 16:57 編輯

回復 24# Blade
  1. Option Explicit
  2. Sub 另存新檔測試()
  3.     Dim File_Name As String, xFile As String, xSNo As String, xName As String
  4.         xFile = Range("D6")
  5.         xSNo = Range("L7")
  6.         xName = Range("M7")
  7.                 File_Name = xFile & "_" & xSNo & "_" & xName & ".pdf"
  8.                                 ActiveWorkbook.Save
  9.     ChDrive "D:\"    '已轉換磁碟機 這行不需要 If Mid(CurDir, 1, 1) <> "d" Then ChDrive "d:\"
  10.     ChDir "d:\Account book\INV\"
  11.     If Dir("d:\Account book\INV\*" & xSNo & "*.pdf ") <> "" Then
  12.         MsgBox "發票編號   " & xSNo & "   已開出"
  13.         Exit Sub
  14.     End If
  15.     Do
  16.         File_Name = InputBox("另存新檔", "[檔案存檔]", File_Name)
  17.         If File_Name = "" Then
  18.             Exit Sub
  19.         Else
  20.             If Dir(File_Name) <> "" Then
  21.                 If MsgBox("【注意】檔案名稱已經存在。是否要覆蓋它?如覆蓋它資料將會被更新。", vbYesNo) = vbYes Then
  22.                     Exit Do
  23.                 Else
  24.                     File_Name = ""
  25.                 End If
  26.             End If
  27.         End If
  28.     Loop While Not UCase(File_Name) Like "*.PDF"
  29.     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFile & "_" & xSNo & "_" & xName & ".pdf", Quality:=xlQualityStandard _
  30.         , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  31.     發票更新
  32. End Sub
複製代碼
  1. Sub 發票更新()
  2.     Dim xSNo As Range, i As Integer, y As Integer, R As Integer, RR As Integer
  3.     Set xSNo = Range("L7")
  4.     y = Len(xSNo)                                      '[發票編號]的字串個數
  5.     For i = 1 To y
  6.         If R = 0 And Mid(xSNo, i, 1) Like "[0-9]" Then R = i    '找[發票編號]中第一個數字
  7.         If Mid(xSNo, i, 1) Like "[!0-9]" Then RR = i            '找[發票編號]中最後的文字
  8.     Next
  9.     If RR > R Or R = 0 Or xSNo = 0 Then  '數字在文字之前(或只有文字),只有數字
  10.         MsgBox " 發票有誤 !!!"
  11.    Else
  12.         xSNo = Mid(xSNo, 1, R - 1) & Format(Mid(xSNo,R) + 1, String((y - R + 1), "0"))
  13.     End If
  14.      '如  y - R + 1 = 5
  15.      '如 :Format(568, String((y - R + 1), "0")) => Format(568, "00000") => 5位數:  00568
  16. End Sub
複製代碼

TOP

回復 26# Blade


Find 方法
備註:
每次呼叫本方法後,將儲存 LookIn、LookAt、SearchOrder 及 MatchByte 的設定。
如果下一次呼叫時未指定這些引數,將使用儲存的設定。
設定這些引數將改變 [尋找] 對話方塊中的設定,而修改 [尋找] 對話方塊中的設定,也將改變系統在省略這些引數時所使用的儲存值。
為避免出現麻煩,每次呼叫本方法時,請明確指定這些引數的值。
  1. Option Explicit
  2. Sub FindStudent()
  3.     Dim The_Name As Range
  4.     Sheets("student").Select
  5.     Set The_Name = Cells.Find(InputBox("請輸入學生 ﹝編號﹞ 或 ﹝名稱﹞"), LookAt:=xlWhole, MatchCase:=False)
  6.     '參數 LookAt:=xlWhole    字串全部相同
  7.     '參數 MatchCase:= False  字串不區分大小寫
  8.     '
  9.     If Not The_Name Is Nothing Then
  10.         The_Name.Select
  11.     Else
  12.         MsgBox "找不到學生: ﹝編號﹞ 或 ﹝名稱﹞"
  13.     End If
  14. End Sub
複製代碼

TOP

回復 28# Blade

Range(",").Select
雙引號內是儲存格的位置A1文字格式
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 30# Blade
是這樣嗎?
  1. Option Explicit
  2. Sub Ex()
  3.     Selection.Resize(, 3).Copy Sheets("invoice").Range("L7")
  4.    
  5.     'Selection.Resize(, 3).Copy    :範圍的複製
  6.     'Sheets("invoice").Range("L7") :貼上的位置
  7.     '
  8.     Sheets("invoice").Activate
  9.     Sheets("invoice").Range("K7").Select
  10.    
  11. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 33# Blade
Selection.Resize(列數, 欄數).Copy Sheets("invoice").Range("L7")
省略 列數 =同Selection的列數
省略 欄數 =同Selection的欄數

你說:怎樣可設定無指向的指令
什麼是無指向說明一下
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 35# Blade

我見省略了是這様 Selection.Resize(, 3)
如果,我列和欄都省略,Selection.Resize(,)是否這様?

那就不需用Resize,直接用Selection
36#的內容看不懂為何不直接上傳excel檔說明
37# Selection.Resize(, 13).Copy Sheets("invoice").Selection.Resize(, 13)
2003會錯誤,要改成明確的位置如 [A5] , 另後面.Paste .Select 也會有錯誤,
你的版本可用嗎?
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 人的心地是一畦田,土地沒有播下好種子,也長不出好的果實。 -
返回列表 上一主題