返回列表 上一主題 發帖

[發問] VBA記錄

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
1# 跳轉到 »
發表於 2019-6-4 04:20 | 顯示全部帖子
本帖最後由 n7822123 於 2019-6-4 04:32 編輯

回復 1# PJChen

你給的檔案我打不開!

我自己做個範例
在你每個程序最下面呼叫 "記錄"這個程序即可，要給予程序名稱
如下，請參考看看!
test-0604.rar (35.41 KB)

Sub backupfile()
'你的程式碼開始
'........
'........
'........
'........
'你的程式碼結束
記錄 "backupfile"
End Sub

Sub 選取工作表B2值化()
'你的程式碼開始
'........
'........
'........
'........
'你的程式碼結束
記錄 "選取工作表B2值化"
End Sub

Sub 測試()
'你的程式碼開始
'........
'........
'........
'........
'你的程式碼結束
記錄 "測試"
End Sub

Sub 記錄(ByVal subname As String)
'路徑　D:\0_自訂表單\VBA記錄\
'檔名    VBA_年月日.TXT
Dim ff$, txt As Object
Application.DisplayAlerts = False
Application.ScreenUpdating = False
fpath0 = "D:\0_自訂表單\VBA記錄"    '自己設定路徑
If Dir(fpath0, 16) = "" Then MsgBox "找不到路徑，請確認!": Exit Sub
fname = "VBA_" & Format(Now, "yyyymmdd") & ".txt"
fullnm = fpath0 & "\" & fname
ff = Dir(fullnm)
If ff = "" Then
  Set txt = Workbooks.Add
  txt.Sheets(2).Delete: txt.Sheets(2).Delete
  txt.Sheets(1).[A1] = "Sub " & subname & "..................." & Format(Now, "yyyymmddhhmmss")
  txt.SaveAs fullnm, xlTextPrinter
  txt.Close
End If
Set txt = Workbooks.Open(fullnm)
n& = txt.Sheets(1).Cells(Rows.Count, 1).End(3).Row
Cells(n + 1, 1) = "Sub " & subname & "..................." & Format(Now, "yyyymmddhhmmss")
txt.Close True
End Sub

Sub 開啟txt()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
fpath0 = "D:\0_自訂表單\VBA記錄"    '自己設定路徑
If Dir(fpath0, 16) = "" Then MsgBox "找不到路徑，請確認!": Exit Sub
fname = "VBA_" & Format(Now, "yyyymmdd") & ".txt"
fullnm = fpath0 & "\" & fname
ff = Dir(fullnm)
If ff = "" Then
  MsgBox "找不到" & fullnm & "，請確認!": Exit Sub
Else
  Shell "notepad " & fullnm
End If
End Sub
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
2#
發表於 2019-6-4 04:36 | 顯示全部帖子
本帖最後由 n7822123 於 2019-6-4 04:38 編輯

回復 4# n7822123

txt.Sheets(1).[A1] = "Sub " & subname & "..................." & Format(Now, "yyyymmddhhmmss")
Cells(n + 1, 1) = "Sub " & subname & "..................." & Format(Now, "yyyymmddhhmmss")

這兩行格式沒改的跟你一樣
yyyymmddhhmmss 請改 yyyymmdd hh:mm:ss

test-0604.rar (36.17 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題