自動填入未做列印標記的序號

chi830

請教各位先進~

在某一設計好的資料頁面，想要讓excel自動從 「序號」頁中，帶入目前尚未用過的序號值，有什麼方法嗎?


附上檔案說明~~謝謝大家~~

成品出門證+序號.zip (18.23 KB)

自動編號
下載次數: 8

2015-3-3 14:38

lpk187

1. Sub 列印()
   
2. '
   
3. ' 巨集1 巨集
   
4. '
   
5. '你列印的程式代碼後加上下面這2句
   
6. 
   
7. End1 = Worksheets("序號").Columns("A").Find([B2], , , xlWhole, , 2).Row
   
8. Worksheets("序號").Cells(End1, "B") = "V"
   
9. End Sub
   
10. 
    
11. 
    
12. '在 "統計" 的工作表的程式碼中貼上下面這個程序
    
13. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
14. If Target.Address = [B2].Address Then
    
15.         For Each 序號 In Worksheets("序號").Range("A2:A" & Worksheets("序號").Range("A65535").End(xlUp).Row)
    
16.     ro = 序號.Row
    
17.     If Sheets("序號").Cells(ro, "B") = "" Then
    
18.         [B2] = Worksheets("序號").Cells(ro, "A")
    
19.         End
    
20.     End If
    
21.     Next
    
22. End If
    
23. End Sub

複製代碼

回復 1# chi830

chi830

太棒了~感lpk187先進的回復， 有收獲 ~讚
   改用Button的方式實作，ok~

   但現在想做更進化的功能(不採用button)
   1、user真的列印後，自動回寫序號頁B欄的V，這裡的程式碼應如何修改?
   2、同時列印完，'統計頁'要另存成檔名為'統計頁'B2的excel，例如No.20150007.xls
         統計頁這裡是樞鈕所跑出來的結果值，另存檔後，所求是要原篩選的內容值

  以上~再請先進們賜教~

lpk187

回復 3# chi830


    在ThisWorkbook貼上這個代碼試試

1. Private Sub Workbook_BeforePrint(Cancel As Boolean)
   
2. Pr = Worksheets("統計").Range("B2")
   
3.     For Each fi In Worksheets("序號").Range("A2:A" & Worksheets("序號").Range("A65536").End(xlUp).Row)
   
4.         If Pr = fi Then
   
5.             Worksheets("序號").Cells(fi.Row, "B") = "V"
   
6.             Exit For
   
7.         End If
   
8.     Next
   
9. Patha = ThisWorkbook.Path & "\"
   
10.     Worksheets("統計").Select
    
11.     Range("A1:L10").Select
    
12.     Selection.Copy
    
13.     Workbooks.Add (xlWBATWorksheet)
    
14.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
15.         :=False, Transpose:=False
    
16.     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    
17.         SkipBlanks:=False, Transpose:=False
    
18.     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    
19.         SkipBlanks:=False, Transpose:=False
    
20.     ActiveWorkbook.Worksheets("工作表1").Name = Pr & "統計"
    
21.     Range("A1").Select
    
22.     ActiveWorkbook.SaveAs Filename:=Patha & Pr & ".xlsb", _
    
23.         FileFormat:=xlExcel12, CreateBackup:=False
    
24. Workbooks(Pr & ".xlsb").Close True
    
25. End Sub

複製代碼

chi830

依lpk187所提供的程式碼，稍作event的修改，現已大致完成所期望的功能

但不曉得是否能讓另存的新檔存為.jpg or pdf檔呢?  自已試著改結果是不行的~呵
此目的，是不希望User能自行開啟檔案修正~

以上~謝謝

lpk187

回復 5# chi830


    可以存成PDF檔，不過會和BeforePrint事件形成無限迴圈，所以要設一個停損點給他，也就是要宣告一個公用變數給他做停損點，就可以存成PDF檔了 ，以下代碼你再試試看行不行！

1. Dim N! '宣告一個可做停損的公用變數
   
2. Private Sub Workbook_BeforePrint(Cancel As Boolean)
   
3. If N > 0 Then
   
4.     N = 0 '結束前先把N設回0，這樣就又可以下次執行BeforePrint事件
   
5.     Cancel = False '這裡則是真正停止時，可以列印文件
   
6.     End
   
7. End If
   
8. N = N + 1
   
9. Cancel = True '執行第一次_BeforePrint事件時讓它停止列印
   
10. Pr = Worksheets("統計").Range("B2")
    
11.     For Each fi In Worksheets("序號").Range("A2:A" & Worksheets("序號").Range("A65536").End(xlUp).Row)
    
12.         If Pr = fi Then
    
13.             Worksheets("序號").Cells(fi.Row, "B") = "V"
    
14.             Exit For
    
15.         End If
    
16.     Next
    
17. Patha = ThisWorkbook.Path & "\"
    
18.     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    
19.         Patha & Pr & ".pdf", Quality:=xlQualityStandard, _
    
20.         IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    
21.         True
    
22. End Sub

複製代碼

chi830

回復 6# lpk187

    成品出門證+序號.zip (31.8 KB)

下載次數: 4

2015-3-11 13:05

    轉PDF失敗，會出現「文件未儲存。文件可能已開啟，或在儲存過程中發生錯誤」
   

下載 (13.01 KB)
存PDF失敗

2015-3-11 12:59

    另外請教因「統計」所篩選之結果有長，有短
    若用 Worksheets("統計").Select
             Range("A1:L10").Select
             Selection.Copy
    就只會複製到A1:L10區間資料，能否將所有結果都COPY到呢?

lpk187

成品出門證+序號.rar (35.46 KB)

下載次數: 7

2015-3-11 13:39

試試看
回復 7# chi830

lpk187

試試看
第二個問題如下
Worksheets("統計").Select
Range("A1:L10").Select
Selection.Copy
'上面的式了可以不用有Select所以可以只寫成下面


'              vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv'這一句是可以自己判斷到哪一列
Range("A1:L" & Cells(Rows.Count, "L").End(xlUp).row).Copy

chi830

回復 8# lpk187


   仍是無法存PDF檔呢~ 一樣的錯誤訊息