- 帖子
- 712
- 主題
- 281
- 精華
- 0
- 積分
- 1019
- 點名
- 0
- 作業系統
- Windows 10
- 軟體版本
- Office 2019
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2011-6-30
- 最後登錄
- 2025-5-22
|
- Option Explicit
- Private Sub Worksheet_Change(ByVal Target As Range)
- Application.DisplayAlerts = False
- If Target.Address(0, 0) = "A1" Then
-
- Dim Bo As Workbook, Save_Name As String, E As Object
-
- With ActiveWorkbook
-
- Save_Name = "D:\" & [A1] & ".xls"
- .Sheets("工作表1").Copy
- End With
-
- With ActiveWorkbook
- For Each E In .VBProject.VBComponent
- E.CodeModule.DeleteLines 1, E.CodeModule.CountOfLines
- Next
- .SaveCopyAs Save_Name
- .Close False
- End With
-
- [A1].Select
- End If
-
- Application.DisplayAlerts = True
- End Sub
複製代碼 我在 [A1].Select 下方新增一行 Selection.ClearContents
結果變成無限迴圈~不知道為什麼會這樣~懇求大大們幫忙~謝謝! |
|