Delete VBA

[poleary2000]

I am using code to copy a worksheet to a new workbook. The worksheet I am copying has code associated with it. When I copy this worksheet to the new workbook, I want to delete the code from the new worksheet. The originial has to stay the same.

Any ideas?

[poleary2000]

WOW - No help?

Any suggestions...anyone?

[Ivan F Moala]

On 2002-05-24 08:25, poleary2000 wrote:
WOW - No help?

Any suggestions...anyone?

Patrick...do a search on this.
It has been covered before.
Can't recall....will see if I can drag
out the code before going

[kkknie]

I did some searching at Microsoft and in the help files but found nothing. I think the easiest way to do it would be to insert a blank worksheet, copy all of the data from the original (using cells.copy) and paste them on the new one (using cells.paste). Then move the new one to the new workbook.

K

[Ivan F Moala]

Try this

Sub RemoveAllCode()

'XL2K:

'Dim VBComp As VBComponent, AllComp As VBComponents, ThisProj As VBProject

'XL97 & XL2K:

Dim VBComp As Object, AllComp As Object, ThisProj As Object

Dim WSht As Worksheet

Dim RemoveOK As Integer, Wbk As Workbook



For Each Wbk In Workbooks

    '// Make sure it's not this workbook!!

    If Wbk.Name <> ThisWorkbook.Name Then

        '// Ask the User Just in case!!

        RemoveOK = MsgBox("Remove All code from:= " & Wbk.Name & "?", vbYesNo)

        If RemoveOK = vbNo Then GoTo Nxt

        Set ThisProj = Wbk.VBProject

        Set AllComp = ThisProj.VBComponents

    

        For Each VBComp In AllComp

            With VBComp

                Select Case .Type

                    Case 1, 2, 3

                        'remove modules,Classes & Forms

                        AllComp.Remove VBComp

                    Case 100

                        'Remove Event codes

                        .CodeModule.DeleteLines 1, .CodeModule.CountOfLines

                End Select

            End With

        Next

    End If



    Set ThisProj = Nothing

    Set AllComp = Nothing

    

    Application.DisplayAlerts = True



Nxt: Next



MsgBox "Done!" & Space(20), vbInformation + vbSystemModal



End Sub

[poleary2000]

Thanks. The adding of a workbook and using the cells.copy command works fine. However, the format [column sizing, cell merging] is not right. Do I have to paste special or something?

Also, Ivan you answered a question for me the other day regarding e-mail in Excel. You supplied me with this code [I've only included a piece of it]

ActiveWorkbook.SendMail strRecipients, "Your copy of worksheet x"
ActiveWorkbook.Close False

This code sends the e-mail immediately. How can I make it give the user the choice to click send on their own.

Thanks,
Patrick

[poleary2000]

Also, when copying the cells to the new sheet in the new workbook, how can I retain the old sheets page setup? Can I transfer that to the new one [i.e. landscape, print area, margins,etc.]?

[Corni]

Using Cells.Copy and Cells.Paste, all cells formatting is preserved (i.e. all column widths, font, sizes, cell merging etc. However, the page setup is lost, and has to be done by code.

For giving the user the opportunity to send the email manually, i.e. to click the send button on the Outlook window, add this line of code:

Application.Dialogs(xlDialogSendMail).Show

[George J]

This is what I use for e-mailing a workbook to clients, without the formulas and code, but retaining the layout and other settings.

Anyone want to alter or amend this, feel free, but let us know how to improve please.

WARNING : the removeCode macro is very effective and should not be run in an original workbook with macros you want to keep.


Sub EMAIL_TellUser()
Dim msg As String
Dim Proceed As Integer

msg = "This routine will create a copy" & vbCr
msg = msg & "of the workbook, but display" & vbCr
msg = msg & "only values, removing all macros." & vbCr
msg = msg & "" & vbCr
msg = msg & "To start this routine click YES" & vbCr
msg = msg & "To cancel this routine Click NO" & vbCr

Proceed = MsgBox(msg, vbInformation + vbYesNo, "Proceed")
If Proceed = vbNo Then End
If Proceed = vbYes Then
Call only_values
Else
End
End If
End Sub


Sub only_values()

Dim wksht As Worksheet


fname = Application.GetSaveAsFilename(filefilter:="Excel Files (*.xls), *.xls")
ActiveWorkbook.SaveCopyAs (fname)
Application.DisplayAlerts = False
Workbooks.Open (fname), False

Application.ScreenUpdating = False

Call removeCode
Call Individual_Fault

numsheets = ActiveWorkbook.Sheets.count

For i = 1 To numsheets
ActiveWorkbook.Sheets(i).Visible = True

Sheets(i).Select

With Sheets(i)
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False

Sheets(i).Cells(1, 1).Select

End With

Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True

ActiveWorkbook.Save

MsgBox "New workbook has been created."

End Sub


Sub removeCode()
Dim awi 'activeWorkbookItem(index)
Dim awcl As Integer 'activeWorkbook Component CountOfLines
Dim count As Integer 'how many potential code modules
Dim i As Integer 'loop counter
On Error Resume Next
count = ActiveWorkbook.VBProject.VBComponents.count
For i = 1 To count
Set awi = ActiveWorkbook.VBProject.VBComponents.Item(i)
awcl = awi.CodeModule.CountOfLines
awi.CodeModule.DeleteLines 1, awcl
Next i
Set awi = Nothing ' Release the object
End Sub


Sub Individual_Fault()
On Error Resume Next
With Application
.CutCopyMode = False
.DisplayAlerts = False
'ActiveWorkbook.Sheets("Individual").Delete 'This sheet kept crashing excel on my system.
.DisplayAlerts = True
End With

End Sub


The macros are NOT all my own, but have taken bits and pieces from other places to enable me to put this thing together.