- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
36#
發表於 2012-5-22 15:07
| 只看該作者
本帖最後由 GBKEE 於 2012-5-22 15:15 編輯
回復 34# PJChen
如 A=A1 A.Cells(1,1) =>A1 ,A.Offset(0,0)=>A1 可隨個人喜好
回復 35# PJChen
有錯誤是因 B27: RAttn:? Mr. Peter Holfelder 中 ? 為 不可見字元 160
程式已修正 符合 印列頁的的格式匯入文字檔中 - Sub try()
- Windows("Shipping for Holfelder.xlsx").Activate
- 'Creat a TXT
- Sheets("Booking").Select
- Cells.Select
- Selection.Copy
- Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
- Dim S As Variant, xS As Variant
- Application.ScreenUpdating = False
- With Workbooks("Shipping for Holfelder.xlsx") '請改成要複製活頁簿的名稱(已經打開)
- 'With Workbooks.Open("P:\Shipping for Holfelder.xlsx") '請改成要複製活頁簿的名稱(尚未打開)
- Set Rng(1) = .Sheets("Booking").[B1:B40] 'Rng(1) 工作表要複製的範圍
- Set Rng(2) = .Sheets("Booking").[A1] 'Rng(2) 存檔名稱的儲存格
- Rng(2) = Rng(2) & "_" & Rng(2).Offset(1) 'Rng(2) 存檔檔名須多加[A2]的儲存格名稱
- 'RowOffset 選擇性的 Variant。用列數表示的區域位移 (正值、負數或零 (0))。正值表示向下位移，負值表示向上位移。預設值為 0。
- 'ColumnOffset 選擇性的 Variant。用欄數表示的區運算式域位移 (整數、負數或 0 (零))。正值表示右位移，負值表示左。預設值為 0。
- End With
- Set Fs = CreateObject("Scripting.FileSystemObject") 'FileSystemObject 物件 提供對電腦檔案系統的存取。
- Set A = Fs.CreateTextFile("P:\TXT\" & Rng(2) & ".txt", True) '建立文字檔案
- 'CreateTextFile 方法 建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
- '如果可被覆蓋其值為 True，其為 False 時無法覆蓋
- Debug.Print Rng(1).Cells(27)
- '*** Debug.Print :即時運算視窗 可見到 RAttn:? Mr. Peter Holfelder 中 ? 為 不可見字元 160" ******
- Rng(1).Replace ChrW(160), "" '**** 消除不可字元 160
- For Each E In Rng(1) '依序處裡複製範圍的儲存格
- S = Split(E, Chr(10))
- If UBound(S) > -1 Then '***有換行 的文字
- For Each xS In S
- A.WriteLine (xS) '儲存格寫入文字檔
- Next
- Else
- A.WriteLine (E.Text) '儲存格寫入文字檔
- End If
- Next
- A.Close
- 'Workbooks.Open ("P:\TXT\" & Rng(2) & ".txt") '這會以EXCEL自動打開TXT類型文件
- Shell "Cmd /c start P:\TXT\" & Rng(2) & ".txt" '自動打開TXT檔
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2012-4-22 18:09
| 
