Private Sub Apply()
Dim Shp As Shape
Dim A As Long
Dim B As Long
On Error GoTo ErrorHandle:
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
ShtPatch1.Unprotect "******"
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Code to make the interface look good...
'(changing the color of three-four cells)
'Code to stop the patch from being applied twice...
'(an if statement that won't apply)
'Move the workbook to the target location before opening
'other workbooks to avoid link errors in 2003
ThisWorkbook.SaveAs "C:/timbrplans/modules/" & ThisWorkbook.Name
'Open target workbook and its dependency (links, again)
GotoWorkbook "tbm_intro.xls"
GotoWorkbook "tbm_homes.xls" 'homes needs intro
'Move some buttons...
With Workbooks("tbm_homes.xls").Sheets("Presentation")
.Select
.Unprotect Password:="open85e3"
For Each Shp In .Shapes
If Shp.Type = 8 Then
Shp.Select
Selection.ShapeRange.IncrementLeft -65
End If
Next Shp
.Protect Password:="open85e3"
End With
'Copy all sheets into the patch, which already contains modules and forms
For A = 1 To Workbooks("tbm_homes.xls").Sheets.Count
B = Workbooks("tbm_homes.xls").Sheets(A).Visible
Application.StatusBar = "Please wait, replacing worksheet #" & ThisWorkbook.Worksheets.Count & " of " & Workbooks("tbm_homes.xls").Worksheets.Count
Workbooks("tbm_homes.xls").Sheets(A).Visible = xlSheetVisible
Workbooks("tbm_homes.xls").Sheets(A).Copy ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Workbooks("tbm_homes.xls").Sheets(A).Visible = B
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - 1).Visible = B
Next A
ThisWorkbook.Activate
Application.StatusBar = "Saving the homes module"
Workbooks("tbm_homes.xls").Close True 'ERROR HERE IF FALSE
'More interface code...
'Save patch over workbook
ThisWorkbook.SaveAs "C:/timbrplans/modules/tbm_homes.xls"
'And finish up
Workbooks("tbm_intro.xls").Close False
Application.StatusBar = False
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
ShtPatch1.Protect "******"
MsgBox "The patch was applied succesfully.", vbInformation, "timbrplans"
Exit Sub
ErrorHandle:
MsgBox "There was an error applying the patch.", vbExclamation, "timbrplans"
Application.StatusBar = False
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
ShtPatch1.Protect "******"
End Sub
Private Sub GotoWorkbook(ByVal Filename As String)
Dim Filepath As String
On Error GoTo Errhandler:
Workbooks(Filename).Activate
Exit Sub
Errhandler:
'If the file wasn't open yet
Application.ScreenUpdating = False
Application.StatusBar = "Please wait, loading " & Filename
Filepath = "C:\timbrplans\modules\" & Filename
If (Dir(Filepath)) = Filename Then
Workbooks.Open Filename:=Filepath, Password:="******"
Else
Filepath = "C:\timbrplans\" & Filename
If (Dir(Filepath)) = Filename Then
Workbooks.Open Filename:=Filepath, Password:="******"
End If
End If
End Sub