用excel打開筆記本 - Excel程式區 - 麻辣家族討論版版

　頭銜: 麻辣路人甲

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

11^# 跳轉到 »

發表於 2012-1-5 17:11 | 只看該作者

本帖最後由 register313 於 2012-1-5 17:15 編輯

回復 9# an13755
回復 9# GBKEE

GBKEE第一版
FileFormat:=xlText 改為 FileFormat:=xlTextPrinter (另儲TXT檔改另儲PRN檔)
但PRN檔每一列超過240字元(好像)就會自動換行

Option Explicit
Sub ZZ()
Dim Rng As Range, i As Integer
Application.ScreenUpdating = False
For i = 1 To 50
' i 是數字 ->Sheets(i) 活頁簿視窗上第幾個工作表
'i & "" 變成字串 ->Sheets(& "") 工作表i
Set Rng = Sheets(i & "").Range("A1:A20") 'Rng設定為工作表i的範圍
With Workbooks.Add(1) '新增活頁簿(工作表1張)
Rng.Copy .Sheets(1).Cells(1) '複製到新增活頁簿第1 張工作表的[A1]
.SaveAs Filename:="D:\" & i & ".txt", FileFormat:=xlTextPrinter, CreateBackup:=False
.Close True
End With
Next i
Application.ScreenUpdating = True
End Sub

複製代碼

TOP

an13755

中學生 Rank: 2

帖子: 20
主題: 7
精華: 0
積分: 50
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
性別: 女
註冊時間: 2010-7-16
最後登錄: 2022-5-27

12^#

發表於 2012-1-5 20:20 | 只看該作者

g大師您好

您幫了小女子1個大忙,讓我節省不少時間

還細心的編寫註解,指導晚輩

生命中多了些許的時間可以運用

都要感謝您的幫忙,謝謝!!

還有r大師l大師也感謝你們的幫忙

r大師最後的程式也可以,謝謝!!

an

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

13^#

發表於 2012-1-15 16:15 | 只看該作者

大大您好,
我看了這個發表想到自己有一個類似的問題,不知能否接著發問?我錄製巨集想從excel sheet("booking")的B3:B35複製貼到TXT的筆記本中,並以sheet("booking")的A1儲存格為檔名,但巨集無法錄製,每次都只出現以下幾行?不知問題出在哪裡?可否解決?

Sub copy_to_TXT()
'
' copy_to_TXT 巨集
'

'
Cells.Select
Selection.Copy
End Sub

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

14^#

發表於 2012-1-15 19:25 | 只看該作者

本帖最後由 GBKEE 於 2012-1-17 10:10 編輯

回復 13# PJChen
試試看

Sub Ex()
Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
Application.ScreenUpdating = False
With Workbooks("test") '請改成要複製活頁簿的名稱
Set Rng(1) = .Sheets("booking").[B3:B35] 'Rng(1) 工作表要複製的範圍
Set Rng(2) = .Sheets("booking").[A1] 'Rng(2) 存檔名稱的儲存格
End With
Set Fs = CreateObject("Scripting.FileSystemObject") 'FileSystemObject 物件提供對電腦檔案系統的存取。
Set A = Fs.CreateTextFile("D:\" & Rng(2) & ".txt", True) '建立文字檔案
'CreateTextFile 方法建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
'如果可被覆蓋其值為 True，其為 False 時無法覆蓋
For Each E In Rng(1) '依序處裡複製範圍的儲存格
A.WriteLine (E) '儲存格寫入文字檔
Next
A.Close
Application.ScreenUpdating = True
End Sub

複製代碼

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

15^#

發表於 2012-1-16 18:22 | 只看該作者

GBKEE大大您好,
我的檔案位置及名稱如下P:\BCM\2011 Shipping for NE.xlsx所以我把它改成 With Windows("P:\BCM\2011 Shipping for NE.xlsx\ Workbooks(Booking") ,執行到第04行出了問題,可以幫我看看哪裡改錯了嗎?

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

16^#

發表於 2012-1-16 20:17 | 只看該作者

回復 15# PJChen
With Workbooks("test")       '請改成要複製活頁簿的名稱
這檔案已經開啟          With Workbooks("2011 Shipping for NE.xlsx")
這檔案尚未經開啟    With Workbooks.Open("P:\BCM\2011 Shipping for NE.xlsx")

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

17^#

發表於 2012-1-16 21:52 | 只看該作者

不好意思,執行還是有問題,請大師幫忙看看:
Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
Application.ScreenUpdating = False
With Workbooks("2011 Shipping for NE.xlsx")  '請改成要複製活頁簿的名稱(已經打開)
      Set Rng(1) = .Sheet("Booking").[B3:B35] '這裡就執行不下了
      Set Rng(2) = .Sheet("Booking").[A1]    'Rng(2) 存檔名稱的儲存格
End With
Set Fs = CreateObject("Scripting.FileSystemObject")       'FileSystemObject 物件提供對電腦檔案系統的存取。
Set A = Fs.CreateTextFile("P:\BCM\Shipping Doc\PJ\HK Packing\" & Rng(2) & ".txt", True) '建立文字檔案
'CreateTextFile 方法建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
'如果可被覆蓋其值為 True，其為 False 時無法覆蓋
For Each E In Rng(1)                         '依序處裡複製範圍的儲存格
      A.WriteLine (E)                         '儲存格寫入文字檔
Next
A.Close
Application.ScreenUpdating = True

TOP

GBKEE