Option Explicit
Public Declare Function LockWindowUpdate Lib "user32.dll" _
(ByVal hwndLock As Long) As Long
Public Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
'-----------------
'Public routines '
'-----------------
Public Sub DisableSaveFile_XL2007()
If ThisWorkbook.FileFormat = xlExcel8 Then
Call SetUpVBSFile
Call ConvertFileFormat
End If
End Sub
Public Sub UpdateRibbon_Now(Dummy As Boolean)
Application.ScreenUpdating = False
With ThisWorkbook
.ChangeFileAccess xlReadOnly
Call Create_CustomUI_And_Rels_Files(ThisWorkbook)
Workbooks.Open .FullName
.Close False
End With
End Sub
Public Sub RestoreFileFormat()
On Error Resume Next
With ThisWorkbook
If .FileFormat <> xlExcel8 Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
.Saved = False
.ChangeFileAccess xlReadOnly
Kill .FullName
.SaveAs .Path & "\" & _
Left(.Name, InStrRev(.Name, ".") - 1) & ".xls", xlExcel8
End If
End With
End Sub
'-----------------
'Private routines '
'-----------------
Private Sub SetUpVBSFile()
Dim sTempVBS As String
Dim sXLSMPathName As String
sTempVBS = Environ("Temp") & "\temp.vbs"
sXLSMPathName = ThisWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & ".xlsm"
Open sTempVBS For Output As #1
Print #1, "On Error Resume Next"
Print #1, "set wb=Getobject(" & Chr(34) & sXLSMPathName & Chr(34) & ")"
Print #1, "Do"
Print #1, "set wb=Getobject(" & Chr(34) & sXLSMPathName & Chr(34) & ")"
Print #1, "If TypeName(wb)=" & Chr(34) & "Workbook" & Chr(34) & "Then exit Do"
Print #1, "Loop"
Print #1, "wb.UpdateRibbon True"
Print #1, "Set wb=Nothing"
Close #1
Do
DoEvents
Loop Until Len(Dir(sTempVBS)) <> 0
'run the background vbs file.
Call Shell("WScript.exe " & sTempVBS)
End Sub
Private Sub ConvertFileFormat()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
LockWindowUpdate .Hwnd
End With
With ThisWorkbook
.ChangeFileAccess xlReadOnly
Kill .FullName
.SaveAs .Path & "\" _
& Left(.Name, InStrRev(.Name, ".") - 1) & ".xlsm", xlOpenXMLWorkbookMacroEnabled
Workbooks.Open .Path & "\" & Left(.Name, InStrRev(.Name, ".") - 1) & ".xlsm"
End With
End Sub
Private Sub Create_CustomUI_And_Rels_Files(wb As Workbook)
Dim oFso As Object
On Error Resume Next
Name wb.FullName _
As Left(wb.FullName, InStrRev(wb.FullName, ".") - 1) & ".zip"
MkDir wb.Path & "\TempFolder"
Zip_Activity "UNZIP", Left(wb.FullName, InStrRev(wb.FullName, ".") - 1) & ".zip" _
, wb.Path & "\TempFolder"
MkDir wb.Path & "\TempFolder\customUI"
Call CreateFiles(wb.Path & "\TempFolder\CustomUI\customUI.xml", _
wb.Path & "\TempFolder\_rels\.rels")
Zip_Activity "ZIPFOLDER", wb.Path & "\TempFolder", wb.FullName
Kill Left(wb.FullName, InStrRev(wb.FullName, ".") - 1) & ".zip"
Set oFso = CreateObject("Scripting.FileSystemObject")
oFso.DeleteFolder wb.Path & "\TempFolder", True
Name wb.FullName & ".zip" As wb.FullName
End Sub
Private Sub CreateFiles(CustomUI As String, Rels As String)
Dim x As Long
Dim FileNum As Long
Dim bytes() As Byte
Dim arCustomUI_Bytes()
Dim arRels_Bytes()
arCustomUI_Bytes = Array(10, 60, 99, 117, 115, 116, 111, 109, 85, 73, 32, 120, 109, 108, 110, 115, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 109, 105, 99, 114, 111, 115, 111, 102, 116, 46, 99, 111, 109, 47, 111, 102, 102, _
105, 99, 101, 47, 50, 48, 48, 54, 47, 48, 49, 47, 99, 117, 115, 116, 111, 109, 117, 105, 34, 62, 10, 10, 32, 32, 60, 99, 111, 109, 109, 97, 110, 100, 115, 62, 10, 32, 32, 32, 32, 60, 33, 45, 45, 32, 68, 195, 169, 115, 97, 99, 116, 105, 118, 101, 32, 108, _
101, 32, 98, 111, 117, 116, 111, 110, 32, 34, 67, 111, 117, 108, 101, 117, 114, 32, 100, 101, 32, 114, 101, 109, 112, 108, 105, 115, 115, 97, 103, 101, 34, 32, 45, 45, 62, 10, 32, 32, 32, 32, 60, 99, 111, 109, 109, 97, 110, 100, 32, 105, 100, 77, _
115, 111, 61, 34, 70, 105, 108, 101, 83, 97, 118, 101, 34, 32, 101, 110, 97, 98, 108, 101, 100, 61, 34, 102, 97, 108, 115, 101, 34, 32, 47, 62, 10, 32, 32, 60, 47, 99, 111, 109, 109, 97, 110, 100, 115, 62, 10, 10, 60, 114, 105, 98, 98, 111, 110, 32, 115, _
116, 97, 114, 116, 70, 114, 111, 109, 83, 99, 114, 97, 116, 99, 104, 61, 34, 102, 97, 108, 115, 101, 34, 62, 10, 10, 60, 47, 114, 105, 98, 98, 111, 110, 62, 10, 60, 47, 99, 117, 115, 116, 111, 109, 85, 73, 62, 10)
arRels_Bytes = Array(239, 187, 191, 60, 63, 120, 109, 108, 32, 118, 101, 114, 115, 105, 111, 110, 61, 34, 49, 46, 48, 34, 32, 101, 110, 99, 111, 100, 105, 110, 103, 61, 34, 117, 116, 102, 45, 56, 34, 63, 62, 60, 82, 101, 108, _
97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 32, 120, 109, 108, 110, 115, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, _
116, 115, 46, 111, 114, 103, 47, 112, 97, 99, 107, 97, 103, 101, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 34, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, _
112, 32, 84, 121, 112, 101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, 116, 115, 46, 111, 114, 103, 47, 111, 102, 102, 105, 99, 101, 68, _
111, 99, 117, 109, 101, 110, 116, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 47, 101, 120, 116, 101, 110, 100, 101, 100, 45, 112, 114, 111, 112, 101, 114, 116, 105, 101, 115, 34, 32, 84, 97, _
114, 103, 101, 116, 61, 34, 100, 111, 99, 80, 114, 111, 112, 115, 47, 97, 112, 112, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 114, 73, 100, 51, 34, 32, 47, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 32, 84, 121, 112, _
101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, 116, 115, 46, 111, 114, 103, 47, 112, 97, 99, 107, 97, 103, 101, 47, 50, 48, 48, 54, 47, 114, 101, 108, _
97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 47, 109, 101, 116, 97, 100, 97, 116, 97, 47, 99, 111, 114, 101, 45, 112, 114, 111, 112, 101, 114, 116, 105, 101, 115, 34, 32, 84, 97, 114, 103, 101, 116, 61, 34, 100, 111, 99, 80, 114, 111, 112, _
115, 47, 99, 111, 114, 101, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 114, 73, 100, 50, 34, 32, 47, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 32, 84, 121, 112, 101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, _
101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, 116, 115, 46, 111, 114, 103, 47, 111, 102, 102, 105, 99, 101, 68, 111, 99, 117, 109, 101, 110, 116, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, _
110, 115, 104, 105, 112, 115, 47, 111, 102, 102, 105, 99, 101, 68, 111, 99, 117, 109, 101, 110, 116, 34, 32, 84, 97, 114, 103, 101, 116, 61, 34, 120, 108, 47, 119, 111, 114, 107, 98, 111, 111, 107, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 114, _
73, 100, 49, 34, 32, 47, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 32, 84, 121, 112, 101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 109, 105, 99, 114, 111, 115, 111, 102, 116, 46, 99, _
111, 109, 47, 111, 102, 102, 105, 99, 101, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 47, 117, 105, 47, 101, 120, 116, 101, 110, 115, 105, 98, 105, 108, 105, 116, 121, 34, 32, 84, 97, 114, 103, 101, 116, 61, 34, 47, 99, 117, 115, 116, 111, _
109, 85, 73, 47, 99, 117, 115, 116, 111, 109, 85, 73, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 82, 100, 56, 102, 49, 52, 57, 50, 97, 52, 97, 97, 102, 52, 102, 53, 98, 34, 32, 47, 62, 60, 47, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 62)
ReDim bytes(LBound(arCustomUI_Bytes) To UBound(arCustomUI_Bytes))
For x = LBound(arCustomUI_Bytes) To UBound(arCustomUI_Bytes)
bytes(x) = CByte((arCustomUI_Bytes(x)))
Next
FileNum = FreeFile
Open CustomUI For Binary As #FileNum
Put #FileNum, 1, bytes
Close FileNum
ReDim bytes(LBound(arRels_Bytes) To UBound(arRels_Bytes))
For x = LBound(arRels_Bytes) To UBound(arRels_Bytes)
bytes(x) = CByte(arRels_Bytes(x))
Next
FileNum = FreeFile
Open Rels For Binary As #FileNum
Put #FileNum, 1, bytes
Close FileNum
End Sub