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

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

複製代碼

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

複製代碼

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

lpk187

回復 12# chi830


    轉存PDF檔，在我幾台電腦試都可以，所以我也不知問題在哪？我再研究看看
至於網路芳鄰，呵呵！我沒用過所以只好請其他大大回答了！

lpk187

回復 15# chi830
另存新檔有如下圖可存成PDF的選項應該都可以存吧！

下載 (262.17 KB)

2015-3-13 16:35

lpk187

回復 18# chi830


    不知道是不是因為版本不同的因素。我的2010在執行預覽列印時，並沒有你說的情況，都會要按列印才會讓BeforePrint事件啟動！

lpk187

回復 20# chi830

1.     For Each fi In Worksheets("序號").Range("A2:A" & Worksheets("序號").Range("A65536").End(xlUp).Row)
   
2.         If Pr = fi Then
   
3.         '這裡加上這段試試vvvvvvvvvvvvvvvvvvvvvvv
   
4.         
   
5.             If fi.Offset(0, 1) = "V" Then
   
6.                 MsgBox "該序號已存在，請先清除列印標記或是重新取號"
   
7.                 Cancel = True
   
8.                 Exit Sub
   
9.             End If
   
10.             
    
11.             '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    
12.             
    
13.             Worksheets("序號").Cells(fi.Row, "B") = "V"
    
14.             Exit For
    
15.         End If
    
16.     Next

複製代碼