remove all macros and forms in file and save the file as xlsx

Alaa mg

Active Member
Joined
May 29, 2021
Messages
343
Office Version
  1. 2019
hi

is there macro remove all macros and forms , shapes and buttons in file XLSM and save the file as XLSX based on date(30/12/2021) .

the file should work until before this date . if I open file in 30/12/2021 then should delete all macros and forms and shapes , buttons in all the sheets

with keep the data contains value, letters ,formatting , borders ,formulas...etc ain all sheets when save the file as xlsx . but before does all what I mentioned should save the file as xlsm in this directory c:\temp just when open file in 30/12/2021 .
I hope my thread is clear .
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Just changed the place of code that deletes shapes, otherwise same code as above.

Also, in your 1st post you said all shapes from the workbook, do you have only 1 sheet? This code only removes shapes from the ActiveSheet which may be some other sheet as well, depending on how it was saved last time it was open.

Edit: Don't use the same file as before, since that one now has the processed property set.

VBA Code:
Private Sub Workbook_Open()

' Check if file was processed before
Dim strProcessed as String

On Error Resume Next

strProcessed = ThisWorkbook.CustomDocumentProperties("Processed")

' If no error while reading "Processed" property (we don't care about its value, just that it is there), then exit sub
If Err.Number = 0 Then
    On Error GoTo 0
    Exit Sub
End If

Err.Clear
On Error GoTo 0

Dim FName As String, Path As String, cPath As String
Dim wb As Workbook
Dim d As Date
Dim shp As Shape

d = DateSerial(2021, 9, 21)
Path = "C:\Temp\"

Set wb = ActiveWorkbook
cPath = wb.Path & "\"
FName = Replace(wb.Name, ".xlsm", "")
If Date >= d Then
    ' Set "Processed" property
    ThisWorkbook.CustomDocumentProperties.Add Name:="Processed",LinkToContent:=False,Type:=msoPropertyTypeString,Value:="Processed"
    Application.DisplayAlerts = False
    ' SAve macro file in Temp
    ActiveWorkbook.SaveAs Filename:=Path & FName, FileFormat:=52 ' or xlOpenXMLWorkbookMacroEnabled

    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next shp

    ' Delete macro file in original folder
    Kill cPath & FName & ".xlsm"
    ' Save non-macro file in original location
    ActiveWorkbook.SaveAs Filename:=cPath & FName, FileFormat:=51 ' or xlOpenXMLWorkbook
    Application.DisplayAlerts = True
End If

End Sub
 
Upvote 0
My four-legged roommate was getting a bit pushy so I had to get out for awhile ...

@Alaa mg, I was and am aware of the consequences of my code. Initially, my code does exactly what you want, albeit with a side effect. Frankly, I assumed that you, as a coder, would keep at least two versions of your workbook. A version for yourself and any future maintenance and a version that will eventually be distributed.

The most suitable approach depends on what you ultimately want to achieve. I don't think in terms of VBA, but the final result. What should the user be confronted with. As you presumably know, any user in Trust Center can very easily disable macros or, even easier, open any workbook in protected mode. Your workbook open event handler is then never executed.
Describe exactly what you ultimately want for the user and then I'll see what's the best way to approach.
 
Upvote 0
now I would answer for your question
in your 1st post you said all shapes from the workbook
when I said the file then should expect another sheets
and I will test your updating
 
Upvote 0
@GWteB ok . I have the file as xlsm I run from directory contain folder in desktop so what I want when run your macro should save the file as xlsm in C:\TEMP\ but without delete shape or buttons should keep all of things as in orginal file from directory contain folder in desktop and should delete your macro from it and at the same time the file orginal should save as xlsx and remove xlsm from directory contain folder in desktop with considering should apply for all sheets in the file .
the aim from this like protection . the user can not run the file is existed in desktop from runing when arrive for specific date
ny user in Trust Center can very easily disable macros or, even easier, open any workbook in protected mode. Your workbook open event handler is
I don't want allowing the user do that . is there way ?
 
Upvote 0
Opening the workbook in protected mode would defeat the purpose though. The ultimate goal is to stop macros from running after the due date, unless I get something wrong, which can already be done with the date check in macro entry points. Implementation would depend on how many such points exist.
 
Upvote 0
As you presumably know, any user in Trust Center can very easily disable macros or, even easier, open any workbook in protected mode. Your workbook open event handler is then never executed.
I don't want allowing the user do that . is there way ?
No, there isn't, but you can design your workbook in such a way, that you force the user to leave macros enabled.
But back to the beginning, once the expiration date has been reached, and the workbook is saved as .XLSX, what's the point of saving the workbook elsewhere on disk in its original state as well?

Anyway, I've modified my code. On the expiration date, an extra worksheet will be inserted in the version that is kept elsewhere, while this worksheet will not be part of the XLSX version. The presence of this worksheet ensures that the original XLSM, which is now in a different place on disk on your request, can still be opened, even though the expiration date has already been reached. When this sheet is present, the workbook acts as a coder version, when this sheet is deleted, the workbook acts as a user version.

This goes in the ThisWorkbook module:
VBA Code:
Private Sub Workbook_Open()
    SanitizeWorkbook Me
End Sub


This goes in a standard module:
VBA Code:
Public Function BuildFullName(ByVal argPath As String, argFileName As String) As String
    If Right(argPath, 1) <> "\" Then argPath = argPath & "\"
    BuildFullName = argPath & argFileName
End Function

Public Sub SanitizeWorkbook(ByVal argWb As Workbook)

    Const TEMPPATH As String = "C:\Temp"                        ' <<<< change to suit
    Const SYSSHEET  As String = "Aala_mg_@sys@"
   
    Dim ExpDate As Date: ExpDate = DateSerial(2021, 9, 18) ' <<<< change year, month, day to suit
    Dim oWs         As Worksheet
    Dim oSysWs      As Worksheet
    Dim Shp         As Shape
    Dim OldFullName As String
    Dim NewFullName As String
    Dim StayAlive   As Boolean

    Application.DisplayAlerts = False
    With ThisWorkbook
   
        On Error Resume Next
        ThisWorkbook.Sheets(SYSSHEET).Range("A1").Value = "@"
        StayAlive = Not CBool(Err.Number)
        On Error GoTo 0
   
        If Date >= ExpDate Then
            If Not StayAlive Then
                OldFullName = .FullName
                NewFullName = BuildFullName(.Path, VBA.Replace(.Name, ".xlsm", ".xlsx", , , vbTextCompare))
                ' save temp version
                Set oSysWs = .Worksheets.Add
                oSysWs.Name = SYSSHEET
                .SaveAs BuildFullName(TEMPPATH, .Name), xlOpenXMLWorkbookMacroEnabled
                ' delete all shapes on all sheets
                For Each oWs In .Worksheets
                    For Each Shp In oWs.Shapes
                        Shp.Delete
                    Next Shp
                Next oWs
                ' save as XLSX in original folder
                oSysWs.Delete
                .SaveAs NewFullName, xlOpenXMLWorkbook
                Kill OldFullName
                .Close False
            End If
        End If
    End With
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
@GWteB your work is very impressive ! thanks , but I have two thing .

first you right

can still be opened, even though the expiration date has already been reached.

. so I would the date sholud be DateSerial(2021, 9, 18) and bigger more than this date .

second

an extra worksheet will be inserted in the version that is kept elsewhere,

is it important?. actually I don't want insert new sheet because I'm fraid deleting a sheet Unintentionally . then it will lose the the orginal data contains macros
thanks again
 
Upvote 0
so I would the date sholud be DateSerial(2021, 9, 18) and bigger more than this date .
You may amend that to your likings.

On the expiration date, an extra worksheet will be inserted in the version that is kept elsewhere, while this worksheet will not be part of the XLSX version.
is it important?. actually I don't want insert new sheet because I'm fraid deleting a sheet Unintentionally . then it will lose the the orginal data contains macros

It is your choice / request to save an XLSM version in another folder on disk. In that version the code has to determine in some way whether the expiration date does apply to that version or not, because otherwise you will no longer be able to use that workbook, you can then never use it again, and judging by your comment, you are now aware of that. That's why I suggested / advised to always keep two versions of a workbook: one for yourself and one for the user.

An alternative could be to work with a key file. If the workbook expires, the code will search for the key file. If not, only an XLSX version will be retained and the original XLSM will be destroyed. If this key file is present, and you are the only one who has that key file obviously , then nothing happens and the workbook is just opened with full access.
But also in a scenario like this applies: if you accidentally delete or have moved the key file, and it is therefore not present when the workbook is opened while the workbook has already expired, you will also lose your XLSM workbook.
So I persist in my advice of two versions: one user version which expires at a certain date and one for yourself, with the workbook open event handler disabled so it never expires.
 
Upvote 0

Forum statistics

Threads
1,215,334
Messages
6,124,319
Members
449,154
Latest member
pollardxlsm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top