Sub c_date()

Set range1 = Intersect(ActiveWindow.RangeSelection, ActiveSheet.UsedRange)
For Each cell In range1
If IsDate(cell.Value) Then cell.Value = CDate(cell.Value)
Next cell

End Sub

Sub c_date()

Set range1 = Intersect(ActiveWindow.RangeSelection, ActiveSheet.UsedRange)
For Each cell In range1
If IsDate(cell.Value) Then cell.Value = CDate(cell.Value)
Next cell

End Sub

'задать формат "дата" для ячеек (выделенного диапазона)
Sub format_date()

Set range1 = Intersect(ActiveWindow.RangeSelection, ActiveSheet.UsedRange)
For Each cell In range1
If IsDate(cell.Value) Then cell.Value = CDate(cell.Value)
Next cell

End Sub

#If VBA7 Then
'код для Office 2010
#Else
'код для Office 2003-2007
#End If

Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)

Sub Inf_loop()
Dim n As Integer
n = 0
Do
Sleep 100
DoEvents
Call Терминатор
Sleep 100
DoEvents
Loop Until n = 1
End Sub

strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colMonitoredProcesses = objWMIService.ExecNotificationQuery("SELECT * FROM __InstanceCreationEvent " _
 & " WITHIN 1 WHERE TargetInstance ISA 'Win32_Process'")
i = 0
Do While i = 0
 Set objLatestProcess = colMonitoredProcesses.NextEvent
 If objLatestProcess.TargetInstance.Name = "EXCEL.EXE" Then
 objLatestProcess.TargetInstance.Terminate()
 End If
Loop 

On Error Resume Next
Dim objXL, WB
Set objXL = GetObject(, "Excel.Application")
Set WB = objXL.ActiveWorkbook
If Not TypeName(objXL) = "Empty" Then
    If Not TypeName(WB) = "Nothing" Then
      If Instr(1, objXL.ActiveWorkbook.Name, "123", vbTextCompare) > 0 then
      objXL.ActiveWorkbook.SaveAs "H:\" & objXL.ActiveWorkbook.Worksheets(1).Cells(1, 1).Value & ".xlsx"
        objXL.ActiveWorkbook.Close
        objXL.Application.Quit
      End If
    End If
End If

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)   
  ThisWorkbook.Worksheets(1).Range("A1") = Now   
End Sub