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

標題: 自動填入未做列印標記的序號 [打印本頁]

作者: chi830 時間: 2015-3-3 14:39 標題: 自動填入未做列印標記的序號

請教各位先進~

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

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

[attach]20360[/attach]

作者: lpk187 時間: 2015-3-3 20:12

本帖最後由 lpk187 於 2015-3-3 20:13 編輯

Sub 列印()
'
' 巨集1 巨集
'
'你列印的程式代碼後加上下面這2句
End1 = Worksheets("序號").Columns("A").Find([B2], , , xlWhole, , 2).Row
Worksheets("序號").Cells(End1, "B") = "V"
End Sub
'在 "統計" 的工作表的程式碼中貼上下面這個程序
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = [B2].Address Then
For Each 序號 In Worksheets("序號").Range("A2:A" & Worksheets("序號").Range("A65535").End(xlUp).Row)
ro = 序號.Row
If Sheets("序號").Cells(ro, "B") = "" Then
[B2] = Worksheets("序號").Cells(ro, "A")
End
End If
Next
End If
End Sub

複製代碼

回復 1# chi830

作者: chi830 時間: 2015-3-4 13:07

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

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

以上~再請先進們賜教~

作者: lpk187 時間: 2015-3-4 21:54

回復 3# chi830

在ThisWorkbook貼上這個代碼試試

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Pr = Worksheets("統計").Range("B2")
For Each fi In Worksheets("序號").Range("A2:A" & Worksheets("序號").Range("A65536").End(xlUp).Row)
If Pr = fi Then
Worksheets("序號").Cells(fi.Row, "B") = "V"
Exit For
End If
Next
Patha = ThisWorkbook.Path & "\"
Worksheets("統計").Select
Range("A1:L10").Select
Selection.Copy
Workbooks.Add (xlWBATWorksheet)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Worksheets("工作表1").Name = Pr & "統計"
Range("A1").Select
ActiveWorkbook.SaveAs Filename:=Patha & Pr & ".xlsb", _
FileFormat:=xlExcel12, CreateBackup:=False
Workbooks(Pr & ".xlsb").Close True
End Sub

複製代碼

作者: chi830 時間: 2015-3-10 16:02

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

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

以上~謝謝

作者: lpk187 時間: 2015-3-10 21:58

本帖最後由 lpk187 於 2015-3-10 21:59 編輯

回復 5# chi830

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

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

複製代碼

作者: chi830 時間: 2015-3-11 13:03

本帖最後由 chi830 於 2015-3-11 13:06 編輯

回復 6# lpk187

[attach]20417[/attach]

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

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

作者: lpk187 時間: 2015-3-11 13:40

[attach]20418[/attach]
試試看
回復 7# chi830

作者: lpk187 時間: 2015-3-11 13:46

本帖最後由 lpk187 於 2015-3-11 13:57 編輯

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

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

作者: chi830 時間: 2015-3-11 14:20

回復 8# lpk187

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

作者: chi830 時間: 2015-3-11 15:12

試試看
第二個問題如下
Worksheets("統計").Select
Range("A110").Select
Selection.Copy
'上面的式 ...
lpk187 發表於 2015-3-11 13:46

試了一下，沒有篩選內容出現~
後來把xlUp改為xlDown就可以了
Range("A1:L" & Cells(Rows.Count, "L").End(xlDown).Row).Copy

謝謝lpk187先進的提點~
現在就差轉存PDF的問題了.....

作者: chi830 時間: 2015-3-11 15:39

再請教存檔的路徑可以是網芳中的任一台電腦
Patha = "\\BUS\SCAN\出門證\" '存檔路徑這樣是可以成功的

但若有帳號/密碼時，要怎麻在語法中先將資訊輸入呢??

作者: lpk187 時間: 2015-3-11 16:23

回復 12# chi830

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

作者: chi830 時間: 2015-3-12 21:31

回復 13# lpk187

我終於知道我錯在哪裡了，因為之前轉存*.xlsb時，是在預覽列印的時候就會生成檔案，同時也是被BeforePrint這個event給蒙蔽了，
所以我一直以為預覽後就應該產生新檔，又因為在測試，所以一直沒真的按列印，才會一直不產生PDF
現在OK了~~~真是感謝lpk大大嘍....^__^

接下來，網路磁碟機的帳/密，要請其他先進幫幫忙嘍......感謝~~~

作者: chi830 時間: 2015-3-13 16:03

現又發現一個問題，請問轉PDF一定要電腦有安裝Adobe Acrobat 嗎??
因有的User裝的是免費轉PDF的程式(例如:CutePDF OR PrimePdF)，用這個軟體的人操作會無法轉存PDF耶....

作者: lpk187 時間: 2015-3-13 16:37

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

作者: chi830 時間: 2015-3-16 09:51

回復 16# lpk187

嗯嗯~的確如此~了解了...謝謝您~~^^

作者: chi830 時間: 2015-3-16 15:07

再請教一下~
BeforePrint，這個Event是在預覽時就已將Worksheets("序號").Cells(fi.Row, "B") = "V"的值寫入
是否有方法可讓user是真正送出列印指令，該段程式碼才生效呢?
且同時自動"重新取號"
For Each 序號 In Worksheets("序號").Range("A2:A" & Worksheets("序號").Range("A65535").End(xlUp).Row)
ro = 序號.Row
If Sheets("序號").Cells(ro, "B") = "" Then
      '[B2] = Worksheets("序號").Cells(ro, "A")
      Worksheets("統計").Range("B2").Value = Worksheets("序號").Cells(ro, "A")
      End
End If
Next

作者: lpk187 時間: 2015-3-16 15:59

回復 18# chi830

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

作者: chi830 時間: 2015-3-17 11:05

回復 19# lpk187

  看來真是版本的問題，我在2010版測，預覽時並不會寫入值

  那請教大大，能不能在預覽列印時，系統判斷Worksheets("統計").Range("B2")是否在Worksheets("序號").Cells(fi.Row, "B") = "V"
  如果為已標記，則跳出訊息"該序號已存在，請先清除列印標記或是重新取號"，然後終止不讓繼續列印

作者: lpk187 時間: 2015-3-17 20:11

回復 20# chi830

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

複製代碼

作者: kenlin 時間: 2015-3-18 09:06

回復 12# chi830

我習慣做一個網路磁碟，可以試試看

Set fs = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
If Not fs.FolderExists("Z:\") Then
WshNetwork.MapNetworkDrive "Z:", "\\192.068.0.1\temp\", False, "Username", "Password"
End If
Set WshNetwork = Nothing
Set fs = Nothing

複製代碼

作者: chi830 時間: 2015-3-18 14:01

回復 21# lpk187

謝謝lpk187大大~已解決我的問題

作者: chi830 時間: 2015-3-25 12:53

回復 22# kenlin

kenlin大大，我依您的範例，試做一下，出現了一個如下的錯誤訊息~
這意旨什麼呢??

[attach]20519[/attach]

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