Board logo

標題: [發問] 盤點表及標籤 VBA [打印本頁]
作者: PJChen    時間: 2017-8-13 23:53     標題: 盤點表及標籤 VBA

我想利用盤點表輸出儲位的標籤,因為有關新增列的部份,沒有辦法錄製巨集,有勞大家幫忙...感謝  [attach]27633[/attach]

1..        VBA程式請放在VBA報表指令.xlsm 檔案中
2..        將ERP_Data.xlsx的庫存.sheet建立一個單獨的複本,存為Q:\00_科毅\出貨文件連結\VBA輸出報表\盤點表.xlsx
3..        存檔時若已有盤點表的檔案存在時,不覆蓋,自動存為"盤點表_NOW" (YYYYMMDD.HHMM)
4..        數值化 盤點表.xlsx使之不要有任何公式 (原檔案有公式,只是為了測試而預先值化了)
5..        使系統不做任何詢問,不存檔直接關閉ERP_Data.xlsx
6..        將盤點表.xlsx 1102:1104列的統計資料刪除
7..        AL欄篩選出大於0及非空格的資料
8..        AH欄篩選出等於1的資料
9..        新增一個sheet並命名為Label,版面配置的上下左右邊界皆為0
10..        copy G、AC、AD、AL、AM連同表頭 (儲存格格式,欄寬都要相同)到Label.sheet,從B1開始依序貼上
       
以下的動作皆在Label.sheet
11..        F欄所有等於"V"的欄位,在下方增加二列空白
12..        並將F欄等於"V"的同一列的D欄儲存格內容,完全copy到新增空白列的第一列C欄位置,並且文字左右置中
13..        A1 鍵入"Item",並在A2一直到資料最底部，key入1.2.3等差數列,並且文字左右置中
14..        從D:F欄插入3欄空白,copy B:C 至E:F
15..        A:I加上篩選鍵,B2凍結窗格
16..        設定列印範圍為B:F
17..        儲存檔案,不關閉
作者: PJChen    時間: 2017-8-20 00:00

您好,

我將程式修正為以下,
1..        VBA程式請放在VBA報表指令.xlsm 檔案中
2..        將ERP_Data.xlsx的庫存.sheet複製到 盤點表.xlsx (先clear,再貼上值)
3..        存檔時若已有盤點表的檔案存在時,不覆蓋,自動存為"盤點表_YYYYMMDD.HHMM
4..        使系統不做任何詢問,不存檔直接關閉ERP_Data.xlsx
5..        copy 盤點表.sheet G、AC、AD、AH:AJ、AL、AM欄連同表頭 (儲存格格式,欄寬都要相同)到Label.sheet,從B欄開始依序貼上並加上篩選鍵
6..        A2一直到資料最底部，key入1.2.3等差數列,並且文字左右置中
7..        複製一個Label.sheet>>Label (2)

        以下的動作皆在Label (2).sheet
8..        Label (2) H欄篩選出=0的資料並刪除
9..        Label (2) E欄篩選出不等於1的資料並刪除
10..        I欄所有等於"V"的欄位,在下方增加二列(整列式)空白
11..        並將I欄等於"V"的同一列的D欄儲存格內容,完全copy到新增空白列的第一列C欄位置,並且文字左右置中
12..        儲存檔案,不關閉
[attach]27642[/attach]  [attach]27643[/attach]  [attach]27644[/attach]


有一部份的程式已經做好了，但...
1) 運作不正常,檔案無法自行開啟
2) 5~12無法用錄製巨集方式作業(因為資料不是固定模式的,常有增減),能夠幫忙寫後續程式嗎？
  1. Sub 盤點表()
  2.     Dim Msg As Boolean, W As Workbook, Wb As Workbook  'W As "來源檔"      Wb As "目的檔"
  3.     'Boolean 型態的預設值為 False
  4.     '*******Workbooks 開啟的活頁簿物件集合****
  5.     For Each W In Workbooks
  6.         If UCase(W.Name) = UCase("ERP_Data.xlsx") Then
  7.             Msg = True  '檔案已開啟
  8.             Exit For
  9.         End If
  10.     Next
  11.     '*****************************************來源檔
  12.     If Msg = True Then '檔案已開啟
  13.         Set W = Workbooks("ERP_Data.xlsx")
  14.     Else               '檔案尚未打開時
  15.         Set W = Workbooks.Open("Q:\00_科毅\出貨文件連結\ERP_Data.xlsx")
  16.     End If
  17.     '*******Workbooks 開啟的活頁簿物件集合****目的檔
  18.     If Msg = True Then '檔案已開啟
  19.         Set Wb = Workbooks("盤點表.xlsx")
  20.     Else               '檔案尚未打開時
  21.         Set Wb = Workbooks.Open("Q:\00_科毅\出貨文件連結\盤點表.xlsx")
  22.     End If
  23. '*****************************************複製到新的活頁薄
  24.     With W.Sheets("庫存")
  25.     Set xRng = .UsedRange  'UsedRange->工作表所使用的全部範圍
  26.     xRng.Copy '複製
  27.     End With
  28.     With Wb.Sheets("盤點表")
  29.        .Range("A1").PasteSpecial xlPasteValues '選擇性貼上
  30.        '.Range("A1").Paste '完全貼上(無效)
  31.     Application.CutCopyMode = False      '***不處於剪下或複製模式
  32.      End With
  33.   W.Close False    '關閉檔案(不會問是否存檔)
  34. '*****************************************
  35.     With Wb.Sheets("盤點表")
  36.     ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2 '打開隱藏群組

  38. 'Wb.Save
  39.     End With
  40. End Sub
複製代碼




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