- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
7#
發表於 2012-12-13 18:39
| 只看該作者
回復 6# et010884 - Option Explicit
- Dim Word檔 As String '匯出word檔,存檔的名稱
- Dim 紀錄 As Range
- Sub 匯出word() '由清單複製後匯出word檔
- Set 紀錄 = Sheets("紀錄").[c2:m2]
- MsgBox Application.CountA(紀錄)
- If Application.CountA(紀錄) <> 11 Then
- MsgBox "資料不齊全": Exit Sub
- Else
- Do
- Word檔 = Application.InputBox("*.doc", "匯出word檔,存檔的名稱")
- Loop While Word檔 = "False" Or Word檔 = ""
- If Not InStr(LCase(Word檔), "*.doc") Then Word檔 = Word檔 & ".doc"
- End If
- Main
- 清單檢查
- End Sub
- Sub 清單檢查() '檢查紀錄不存在: 詢問是否加入
- Dim R As Integer, E As Range, MM As String
- Set 紀錄 = Sheets("紀錄").[c2:m2]
- With Sheets("清單")
- R = .Cells(.Rows.Count, "c").End(xlUp).Row '清單:紀錄的列數
- If R = 1 Then
- GoTo OK
- Else
- MM = Join(Application.Transpose(Application.Transpose(紀錄.Value)), vbLf)
- For Each E In .Range("C2:M2").Resize(R - 1).Rows
- If MM = Join(Application.Transpose(Application.Transpose(E.Value)), vbLf) Then GoTo EE
- Next
- End If
- OK:
- If MsgBox(MM, vbYesNo, "記錄: 存入清單..") = vbYes Then
- 紀錄.Copy .Cells(R + 1, "c") '複製到紀錄的列數+1
- .Cells(R + 1, "B").NumberFormatLocal = "@"
- .Cells(R + 1, "B").FormulaR1C1 = Format(R + 1, "000")
- End If
- EE:
- 紀錄.EntireRow = "" '轉換後記錄頁面的資料清空
- End With
- End Sub
- Sub 複製到紀錄()
- Dim Rng As Range
- With Sheets("清單")
- Set Rng = .Range("a1").CurrentRegion.Rows(2)
- Set Rng = Rng.Resize(.Range("a1").CurrentRegion.Rows.Count - 1)
- If Not Application.Intersect(Rng, ActiveCell) Is Nothing Then
- .Range("A" & ActiveCell.Row & ":" & "M" & ActiveCell.Row).Copy Sheets("紀錄").Range("A2")
- MsgBox "編號: " & vbTab & "[" & .Range("B" & ActiveCell.Row) & "]", , "複製到紀錄!!"
- Else
- MsgBox "需選擇在 清單的範圍"
- Rng.Select
- End If
- End With
- End Sub
- Private Sub Main() '記錄匯出到word檔
- With CreateObject("Word.APPLICATION")
- .Visible = True
- ' .Documents.Open ("\\Tctk0fi25\oqa_report$\04_異常處理表單_R3\不合格單開立區\1.doc")
- .Documents.Open (ThisWorkbook.Path & "\1.doc")
- With .ActiveDocument.Tables(1) 'Word檔案中第一個表格
- ' .Cell(2, 1) = Rng(1, 1) '項次
- '.Cell(2, 2) = Rng(1, 2) '編號
- .Cell(2, 2) = 紀錄(1, 1) '發行日期
- .Cell(2, 3) = 紀錄(1, 2) 'Product code
- .Cell(2, 4) = 紀錄(1, 3) '客戶
- .Cell(2, 5) = 紀錄(1, 4) 'Product code
- .Cell(2, 6) = 紀錄(1, 5) 'Lot id
- .Cell(2, 7) = 紀錄(1, 6) 'line
- .Cell(2, 8) = 紀錄(1, 7) 'Qty
- .Cell(4, 2) = 紀錄(1, 8) '內容
- .Cell(5, 3) = 紀錄(1, 9) '收件日期
- .Cell(5, 7) = 紀錄(1, 10) '核對人
- .Cell(9, 4) = 紀錄(1, 11) 'Detail Explain
- '.Cell(?, ?)= 職稱 ,年資 , 紀錄, 面談者:餘下資料請自行填入
- End With
- .ActiveDocument.SaveAs Filename:="D:\TEST\" & Word檔 '*** WORD匯出 ***
- .ActiveDocument.Close '關閉word檔 'True
- .Quit '關閉word應用程式
- End With
- End Sub
|
|
發表於 2012-12-5 16:22
| 
