我想打开文件,刷新数据(自动(并将更新后的文件复制到另一个文件夹。
我的代码是:
Option Explicit
Public Duree As Date
Function FichierExiste(FPath As String) As Boolean
Dim NomF As String
NomF = Dir(FPath)
If NomF <> "" Then FichierExiste = True _
Else: FichierExiste = False
End Function
Sub Fermer()
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Application.DisplayAlerts = False
With ThisWorkbook
.RefreshAll
.Save
.Close
Application.DisplayAlerts = False
Call
oFSO.CopyFile("\XXXXDossier_avantFichier.xlsm", "\XXXXDossier_apres", True)
End With
End Sub
Sub StartHeure()
Duree = Now + TimeValue("01:00:30")
Application.OnTime Duree, "Fermer"
End Sub
关于本手册:
Option Explicit
Private Sub Workbook_Open()
If FichierExiste("XXXXDossier_apresFichier.xlsm") = False Then
Call StartHeure
Else
ActiveWorkbook.Close True
End If
End Sub
当我复制更新的文件时,函数=today((仍然没有更新。我想知道我的鳕鱼哪里出了问题。
谢谢你的帮助!
请测试这种保存方式:
Sub Fermer()
Dim oFSO As Object, dateRng As Range
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set dateRng = ThisWorkbook.Sheets("my sheet").Range("J8") 'update here the range keeping the formula "=Now()" formula!
Application.DisplayAlerts = False
With ThisWorkbook
.RefreshAll
dateRng.value = dateRng.value
.Save
oFSO.CopyFile "\XXXXDossier_avantFichier.xlsm", "\XXXXDossier_apres", True
dateRng.Formula = "Now()"
.Close , True 'it is saved before closing (to keep the formula
End With
Application.DisplayAlerts = True
End Sub
编辑:复制它的版本没有任何公式:
Sub FermerNoFormula()
Dim wb As Workbook, sh As Worksheet
Set wb = ThisWorkbook
Application.DisplayAlerts = False
With wb
.RefreshAll
.saveas "\XXXXDossier_apres" & ThisWorkbook.Name
For Each sh In wb.Sheets
sh.UsedRange.value = sh.UsedRange.value
Next sh
.Close , True 'it is saved before closing
End With
Application.DisplayAlerts = True
End Sub