每十分自动另存到指定路径

jivy1212

准提部林 发表于 2022-5-11 13:51
SAVECOPYAS 無法設定其它屬性, 原汁原味的複製,
若副本也開啟了, 而且啟用宏, 那就有兩個檔案同時跑ONTIME ...

另存的工作薄不点“启用内容”是不会自动运行的，但确实不完美，SaveAs加参数是可以存成XLSL格式（Fileformat:= 51），我研究下多绕下圈能做到想要的功能不。没VBA基础，有点难弄。

gdhdlzy

可以跨电脑查看不？

准提部林

1) 檔案開啟, 即自動執行, 關閉時, 取消上一次的預訂時間(避免檔案自動重啟)
2) 以excel使用者名稱為判別, 即在別的PC上, 名稱不同, 即不執行該程序
3) 在H1設開關, 輸入0, 停止運作, 輸入"1111", 重新運作(可自訂單元格及數字)

Xl0000106-v02.rar (14.2 KB, 下载次数: 7)

2022-5-12 10:32 上传

点击文件名下载附件

jivy1212

准提部林 发表于 2022-5-12 10:36
1) 檔案開啟, 即自動執行, 關閉時, 取消上一次的預訂時間(避免檔案自動重啟)
2) 以excel使用者名稱為判別, ...

1. Sub AutoSave()
   
2. Application.ScreenUpdating = False
   
3. Application.OnTime Now() + TimeValue("00:03:00"), "WbSave"       'N分钟保存一次
   
4. Application.ScreenUpdating = True
   
5. End Sub
   
6. 
   
7. 
   
8. 
   
9. 
   
10. Sub WbSave()
    
11. Dim last As Integer
    
12.   Dim WBK, Wb  As Excel.Workbook
    
13.   Dim Sh  As Excel.Worksheet
    
14. 
    
15.     Set WBK = Application.ActiveWorkbook
    
16.     Set Sh = WBK.Sheets("sheet1")
    
17.    
    
18. last = Sh.Range("C65536").End(xlUp).Row 'Range("B65536").End(xlUp).Row - 2 '导入
    
19.     Application.ScreenUpdating = False
    
20.     Application.DisplayAlerts = False
    
21.    
    
22.   
    
23. Set Wb = Workbooks.Add(xlWBATWorksheet)
    
24.     With Wb '添加新工作簿
    
25.         .Worksheets(1).Name = "Sheet1"   '工作表改名
    
26.        ' Sh.Cells.Copy .Worksheets(1).Cells '复制单元格
    
27.         Sh.Range("A1:G" & last).Copy .Worksheets(1).Range("A1:G" & last)
    
28.         .SaveAs Filename:="D:\DHRP\EXCEL\test66.xlsx", FileFormat:=51  '
    
29.         .Close False
    
30.     End With
    
31. Call AutoSave
    
32. Application.ScreenUpdating = True
    
33. Application.DisplayAlerts = True
    
34. End Sub
    

复制代码

谢谢。我接凑了一个，好像也成功了

zyhui1961

老师您好！
请你帮忙：下面是我录制的宏的内容，单独运行没有问题。
    Sheets("成绩查询").Select
    Range("AA5:AA69").Select
    Selection.Copy '复制文本
    Range("Z5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=F
alse, Transpose:=False '粘贴数值
    Range("Z5").Select
可是我加一个工作表事件，为什么就运行不了？
Private Sub Worksheet_Change(ByVal Target As Range) '工作表触发事件
    Set Myrng = Range("A1")   
    Sheets("成绩查询").Select
    Range("AA5:AA69").Select'老是从这个地方开始卡住了
    Selection.Copy '复制文本
    Range("Z5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False '粘贴数值
    Range("Z5").Select
End Sub