返回列表 上一主題 發帖

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

回復 20# Blade
是17#的程式碼有誤 已修正

TOP

回復 17# GBKEE
:) 成功了,感謝!
請問版大你改了那裡呢?我看了幾遍還是找不到,不同之處。
  1. If Dir("d:\Account book\INV\*" & xSNo & "*.pdf ") <> "" Then
  2.      MsgBox "【注意】此收據編號 " & xSNo & " 早前已開出,請重新輸入。"
  3.     Exit Sub
  4.         End If
複製代碼
如果我想把code改成如下,不論是 xFile、xSNo、xName,是否都是放在同一位置?
  1. If Dir("d:\Account book\INV\*" & xFile & "*.pdf ") <> "" Then
  2.      MsgBox "【注意】此收據編號 " & xFile & " 早前已開出,請重新輸入。"
  3.     Exit Sub
  4.         End If
複製代碼

TOP

回復 22# Blade
20#  If Dir("d:\Account book\INV\*" & " xSNo " & "*.pdf ") <> "" Then
多了兩個"   ,   " xSNo " 為字串-> "d:\Account book\INV\* xSNo  *.pdf "  

正確:
If Dir("d:\Account book\INV\*" & xSNo & "*.pdf ") <> "" Then
如 xSNo="test"
字串="d:\Account book\INV\*" & "test"& "*.pdf "

TOP

本帖最後由 Blade 於 2012-12-22 14:30 編輯
回復  Blade
20#  If Dir("d:\Account book\INV\*" & " xSNo " & "*.pdf ")  "" Then
多了兩個"   ,   " ...
GBKEE 發表於 2012-12-22 11:45

成功了:D

我現時用了一個比較笨的方法,去打入收據編號,
便是按一下收據編號隔鄰的紅色按鈕,便會跳到invno那sheet之後按
一下長方紅色按鈕,便剪貼回收據編號那處,
每一次都是這樣。
如果紅色那列的編號用完,便按一下綠色的按鈕,把那行的編號剪貼到最左面紅色按鈕處來補充
請問有甚麼好的方式去超越這方法?

2012-12-22_142408.jpg (143.4 KB)

2012-12-22_142408.jpg

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

2012-12-21_164758.jpg

TOP

本帖最後由 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

回復  Blade
GBKEE 發表於 2012-12-22 16:31


我在invoice sheet加了一個click key,係去搵 student sheet 的學生資料,Inputbox成功跳出來,我鍵入會員編號後,沒有跳到那會員的"列",請問欠缺了甚麼指令?
另外那個InputBox是跳到student sheet開啟,如果我想那個InputBox停留在invoice,到我鍵入學生資料後,才跳到student sheet可以嗎?
  1. Sub FindStudent()
  2.     Sheets("student").Select
  3.     InputBox ("請輸入學生 ﹝編號﹞ 或 ﹝名稱﹞")
  4.     Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
  5.         :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
  6.         False, MatchByte:=False, SearchFormat:=False).Activate
  7.         Exit Sub
  8.         
  9. 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

我今次又遇到離題。
請指教
早前經大大指教下,寫了以下指令。
Rang部分,指定了A3:B3,但是我不想指定A3:B3,每次我都自己選不同Rang,那麼我應怎修改?
  1. Sub StudentCopy()

  2. Selection.Copy
  3. Range("A3:B3").Select
  4. Sheets("invoice").Select
  5. Range("L7").Select
  6. ActiveSheet.Paste
  7. Application.CutCopyMode = False
  8. Range("K7").Select

  9. End Sub
複製代碼
我自己試修改成這樣,但都是出錯誤。
  1. Range(",").Select
  2.      Selection.Copy
  3.         Sheets("invoice").Select
  4.     Range("L7").Select
  5.     ActiveSheet.Paste
  6.     Application.CutCopyMode = False
  7.     Range("K7").Select
  8. End Sub
複製代碼

TOP

回復 28# Blade

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

TOP

回復  Blade

Range(",").Select
雙引號內是儲存格的位置A1文字格式
GBKEE 發表於 2014-1-16 07:43



  應該是這様說:
  我現時每一位會員都做了一個鍵給他們,只要按下那鍵便會把AB會員編號及名稱一同copy到invoice那頁的只定區。
後來發覺人數增長大了,我沒可能每位會員也給他一個鍵,因此我做了一個"圖片"右上粉色的選取鍵,我只要指向會員編號再按shift再選名稱,之後再按下一粉色鍵便成功把會員編號及名稱一同copy到invoice。
  但現在我安排了平板電腦給前線客戶專員,如果用手指去操控,要選A編號及B名稱是有難題的,所以我想的方法是,我指向想要的會員編號,但當我按一下選取鍵,便能自動地連同會員名稱也一起copy,到invoice。

螢幕快照 2014-01-17 上午12.51.46.png (48.76 KB)

螢幕快照 2014-01-17 上午12.51.46.png

TOP

        靜思自在 : 世上有兩件事不能等:一、孝順 二、行善。
返回列表 上一主題