麻辣家族討論版版 - Powered by Discuz! Board

標題: 寫一個另存新檔的巨集，但是需要.pdf file，那麼應怎改寫？ [打印本頁]

作者: Blade 時間: 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 時間: 2012-12-16 19:47

回復 1# Blade

Sub SaveAS()
是否另存新檔 = MsgBox("是否另存新檔?", vbYesNo)
If 是否另存新檔 = vbYes Then
File = Application.Range("D6")
Name = Application.Range("M7")
ActiveWorkbook.SaveAS Filename:=File & "-" & Name & ".xlsm"
End If
End Sub

複製代碼

Excel 2010制作PDF

Sub PrintPDF()
是否另存新檔 = MsgBox("是否用當前頁制作PDF?", vbYesNo)
If 是否另存新檔 = vbYes Then
File = Application.Range("D6")
Name = Application.Range("M7")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
File & "-" & Name & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
End Sub

複製代碼

作者: Blade 時間: 2012-12-17 17:10

感謝！

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

作者: Blade 時間: 2012-12-17 22:46

回復 2# kimbal

感謝！

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

作者: GBKEE 時間: 2012-12-18 11:12

回復 4# Blade
試試看

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 & ".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 "*.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

複製代碼

作者: Blade 時間: 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

作者: GBKEE 時間: 2012-12-18 16:38

回復 6# Blade
有何問題嗎?

作者: Blade 時間: 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

作者: GBKEE 時間: 2012-12-19 07:49

回復 8# Blade
Name ,File 是VBA使用的關鍵字變數,程序名稱要避免使用

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" 'UCase(File_Name) 大寫 *.XLSM
Loop While Not LCase(File_Name) Like "*.xlsm" 'LCase(File_Name) 小寫 *.xlsm
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=File_Name
File_Name = Replace(LCase(File_Name), "*.xlsm", ".dbf") '副檔名替換為 "dbf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
xFile & "-" & xName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Application.DisplayAlerts = True
End Sub

複製代碼

作者: Blade 時間: 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)

作者: GBKEE 時間: 2012-12-20 10:56

回復 10# Blade
每次發單時，另存後都是格式 INV12345_會員編號1_客戶名稱1.pdf
到了下一張單時，她又忘了更改INV12345，因此會出現 INV12345_會員編號2_客戶名稱2.pdf
請問:為何會自動加1??

Option Explicit
Sub Ex()
ChDrive "C:\" '轉換使用中的磁碟機
ChDir "C:\test" '改變使用中目錄或檔案夾。
ChDir "D:\test" '改變非使中磁碟機目錄或檔案夾
MsgBox CurDir '傳回使用中磁碟機:的的路徑
ChDrive "D:\" '轉換使用中的磁碟機
MsgBox CurDir '傳回使用中磁碟機:的的路徑
'** 如這樣使用中的磁碟機不是d
If Mid(CurDir, 1, 1) <> "d" Then ChDrive "d:\"
ChDir "d:\Account book\INV\"
' **** 或是加上路徑****
ActiveWorkbook.SaveAs Filename:="d:\Account book\INV\" & File_Name
File_Name = Replace(LCase(File_Name), "*.xlsm", ".dbf") '副檔名替換為 "dbf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"d:\Account book\INV\" & File_Name, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
' ***************
End Sub

複製代碼

作者: Blade 時間: 2012-12-20 16:34

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

作者: GBKEE 時間: 2012-12-20 17:02

回復 12# Blade

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

複製代碼

作者: Blade 時間: 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

作者: GBKEE 時間: 2012-12-21 06:23

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

回復 14# Blade

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

複製代碼

作者: Blade 時間: 2012-12-21 13:54

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

作者: GBKEE 時間: 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

複製代碼

作者: Blade 時間: 2012-12-21 16:49

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

感謝版大:D

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

作者: GBKEE 時間: 2012-12-21 17:06

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

作者: Blade 時間: 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

複製代碼

作者: GBKEE 時間: 2012-12-22 07:22

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

作者: Blade 時間: 2012-12-22 11:13

回復 17# GBKEE
:) 成功了，感謝！
請問版大你改了那裡呢？我看了幾遍還是找不到，不同之處。

If Dir("d:\Account book\INV\*" & xSNo & "*.pdf ") <> "" Then
MsgBox "【注意】此收據編號 " & xSNo & " 早前已開出，請重新輸入。"
Exit Sub
End If

複製代碼

如果我想把code改成如下，不論是 xFile、xSNo、xName，是否都是放在同一位置？

If Dir("d:\Account book\INV\*" & xFile & "*.pdf ") <> "" Then
MsgBox "【注意】此收據編號 " & xFile & " 早前已開出，請重新輸入。"
Exit Sub
End If

複製代碼

作者: GBKEE 時間: 2012-12-22 11:45

回復 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 "

作者: Blade 時間: 2012-12-22 14:28

本帖最後由 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之後按
一下長方紅色按鈕，便剪貼回收據編號那處，
每一次都是這樣。
如果紅色那列的編號用完，便按一下綠色的按鈕，把那行的編號剪貼到最左面紅色按鈕處來補充
請問有甚麼好的方式去超越這方法？

作者: GBKEE 時間: 2012-12-22 16:31

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

複製代碼

作者: Blade 時間: 2012-12-22 23:54

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

我在invoice sheet加了一個click key，係去搵 student sheet 的學生資料，Inputbox成功跳出來，我鍵入會員編號後，沒有跳到那會員的"列"，請問欠缺了甚麼指令？
另外那個InputBox是跳到student sheet開啟，如果我想那個InputBox停留在invoice，到我鍵入學生資料後，才跳到student sheet可以嗎？

Sub FindStudent()
Sheets("student").Select
InputBox ("請輸入學生 ﹝編號﹞ 或 ﹝名稱﹞")
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
Exit Sub
End Sub

複製代碼

作者: GBKEE 時間: 2012-12-23 07:30

回復 26# Blade

Find 方法
備註:
每次呼叫本方法後，將儲存 LookIn、LookAt、SearchOrder 及 MatchByte 的設定。
如果下一次呼叫時未指定這些引數，將使用儲存的設定。
設定這些引數將改變 [尋找] 對話方塊中的設定，而修改 [尋找] 對話方塊中的設定，也將改變系統在省略這些引數時所使用的儲存值。
為避免出現麻煩，每次呼叫本方法時，請明確指定這些引數的值。

Option Explicit
Sub FindStudent()
Dim The_Name As Range
Sheets("student").Select
Set The_Name = Cells.Find(InputBox("請輸入學生 ﹝編號﹞ 或 ﹝名稱﹞"), LookAt:=xlWhole, MatchCase:=False)
'參數 LookAt:=xlWhole 字串全部相同
'參數 MatchCase:= False 字串不區分大小寫
'
If Not The_Name Is Nothing Then
The_Name.Select
Else
MsgBox "找不到學生: ﹝編號﹞ 或 ﹝名稱﹞"
End If
End Sub

複製代碼

作者: Blade 時間: 2014-1-16 02:13

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

Sub StudentCopy()
Selection.Copy
Range("A3:B3").Select
Sheets("invoice").Select
Range("L7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("K7").Select
End Sub

複製代碼

我自己試修改成這樣，但都是出錯誤。

Range(",").Select
Selection.Copy
Sheets("invoice").Select
Range("L7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("K7").Select
End Sub

複製代碼

作者: GBKEE 時間: 2014-1-16 07:43

回復 28# Blade

Range(",").Select
雙引號內是儲存格的位置A1文字格式

作者: Blade 時間: 2014-1-17 01:01

回復 Blade

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

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

作者: GBKEE 時間: 2014-1-17 06:52

回復 30# Blade
是這樣嗎?

Option Explicit
Sub Ex()
Selection.Resize(, 3).Copy Sheets("invoice").Range("L7")
'Selection.Resize(, 3).Copy :範圍的複製
'Sheets("invoice").Range("L7") :貼上的位置
'
Sheets("invoice").Activate
Sheets("invoice").Range("K7").Select
End Sub

複製代碼

作者: Blade 時間: 2014-1-17 17:31

回復 Blade
是這樣嗎?
GBKEE 發表於 2014-1-17 06:52

感謝版大的指教。
我想問問，(, 3)是甚麼意思？
範圍是A&B的選定，如果是A-F，那麼是否修改成(, 5....6)，如此類推？

作者: Blade 時間: 2014-1-17 18:33

Sheets("invoice").Range("L7")
另外想請教，以上的指令，是貼上 L7的，怎樣可設定無指向的指令？

作者: GBKEE 時間: 2014-1-17 19:37

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

你說:怎樣可設定無指向的指令
什麼是無指向說明一下

作者: Blade 時間: 2014-1-18 01:35

回復 Blade
Selection.Resize(列數, 欄數).Copy Sheets("invoice").Range("L7")
省略列數 =同Selectio ...
GBKEE 發表於 2014-1-17 19:37

感謝！
Selection.Resize 我完全明白了。:)
我見省略了是這様 Selection.Resize(, 3)
如果，我列和欄都省略，Selection.Resize(,)是否這様？

作者: Blade 時間: 2014-1-18 01:47

本帖最後由 Blade 於 2014-1-18 01:50 編輯

先看看圖片。
我現在懂得用Selection.Resize。
我同様地在course那頁，都做了按鍵給每一個課程。
現我我懂了Selection.Resize，我會用相同指令去處理course那頁，但是copy到invoice，那裡我有5行資料。
如果我 Copy Sheets("invoice").Range("B13")，那麼每次我選course，都只能copy到 B13，另外那4行我應怎編寫指令呢？
Copy Sheets("invoice").Range("B13") 我應用甚麼指令呢？

作者: Blade 時間: 2014-1-18 02:25

Selection.Resize(, 13).Copy Sheets("invoice").Selection.Resize(, 13)
Selection.Resize(, 13).Copy Sheets("invoice").Selection.Resize(, 1).Paste
Selection.Resize(, 13).Copy Sheets("invoice").Range("B13").Select

作者: GBKEE 時間: 2014-1-18 07:09

回復 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 也會有錯誤,
你的版本可用嗎?

作者: Blade 時間: 2014-1-18 11:13

我的是2010

作者: Blade 時間: 2014-1-21 19:14

本帖最後由 Blade 於 2014-1-21 19:16 編輯

當我選了，保護工作表，以下程式便會出錯誤。

Sub InvoiceNo()
Dim xRNo As Range, i As Integer, y As Integer, R As Integer, RR As Integer
Set xRNo = Range("Q2")
'Set xRNo = Range("D5")
y = Len(xRNo) '[發票編號]的字串個數
For i = 1 To y
If R = 0 And Mid(xRNo, i, 1) Like "[0-9]" Then R = i '找[發票編號]中第一個數字
If Mid(xRNo, i, 1) Like "[!0-9]" Then RR = i '找[發票編號]中最後的文字
Next
If RR > R Or R = 0 Or xRNo = 0 Then '數字在文字之前(或只有文字),只有數字
MsgBox "【注意】收據編號出錯 !!!"
Else
xRNo = Mid(xRNo, 1, R - 1) & Format(Mid(xRNo, R) + 1, String((y - R + 1), "0"))
End If
Range("Q2").Select
'Range("D5").Select
Selection.Copy
Range("D6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Range("A4").Select
'如 y - R + 1 = 5
'如 :Format(568, String((y - R + 1), "0")) => Format(568, "00000") => 5位數: 00568
End Sub

複製代碼

出錯誤的句子

xRNo = Mid(xRNo, 1, R - 1) & Format(Mid(xRNo, R) + 1, String((y - R + 1), "0"))

複製代碼

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)