PDA

View Full Version : copy all modules



lior03
12-06-2005, 07:42 AM
i am trying to modify a vba code i found in cpearson site.
i want to copy all modules of the activeworkbook to a new workbook whitch
will be open automaticly through vba, and be given a name in vba.
it do not work.
could it be fixed?
how do i copy thisworkbook module also.
thanks
moshe
Sub CopyAllModules()
Dim FName As String
Dim VBComp As VBIDE.VBComponent
Dim wbnew As Workbook
dim x as string
x=inputbox("wb name is","wb to open")
Set wbnew = Workbooks.Add
set x=workbooks.name
With ActiveWorkbook
FName = .Path & "\code.txt"
If Dir(FName) <> "" Then
Kill FName
End If
For Each VBComp In .VBProject.VBComponents
If VBComp.Type <> vbext_ct_Document Then
VBComp.Export FName
wbnew.VBProject.VBComponents.Import FName
Kill FName
End If
Next VBComp
End With
End Sub

mvidas
12-06-2005, 08:13 AM
Hi moshe,

Give this a try:Sub CopyAllModules()
Dim FName As String
Dim VBComp As VBComponent
Dim wbnew As Workbook
Dim x As String
x = InputBox("wb name is", "wb to open")
Set wbnew = Workbooks.Add
' Set x = Workbooks.Name
' do you mean wbnew.saveas x ?
With ActiveWorkbook
FName = .Path & "\code.txt"
If Dir(FName) <> "" Then
Kill FName
End If
For Each VBComp In .VBProject.VBComponents
If VBComp.Type <> vbext_ct_Document Then
VBComp.Export FName
wbnew.VBProject.VBComponents.Import FName
Kill FName
ElseIf VBComp.Name = "ThisWorkbook" Then
If VBComp.CodeModule.CountOfLines > 0 Then
wbnew.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString _
VBComp.CodeModule.Lines(1, VBComp.CodeModule.CountOfLines)
End If
End If
Next VBComp
End With
End SubShould take care of everything.. your issue was the "Set x = Workbooks.Name", which I commented out and put underneath it the line you probably intended to use. Let me know if you have any questions!
Matt

justme
01-20-2006, 10:43 AM
Hello all,

I think I may be able to use this code, but I get a "Compile error: User-defined type not defined" at line Dim VBComp as VBComponent. Is this code working for you?

Zack Barresse
01-20-2006, 12:06 PM
Hey Justme, you have to set a reference to Microsoft Visual Basic for Applications Extensability 5.3

justme
01-20-2006, 12:32 PM
Hi Zack. I'm getting all balled up in this workbook. I have 60+ workbooks out there that will have to be sent to me monthly (timesheets). Then the active worksheet has to be sent to their manager. I have all this done in code, the big problem is:

When I copy only a section of a worksheet it does not bring over the button and macro I have made for the manager to send it to HR. I figured out how to copy button 4, but the assigned macro did not come with it. I've been pulling my hair out for a week.

Zack Barresse
01-20-2006, 12:49 PM
I'm assuming this is a forms button. Have you tried setting a variable as a string which you use to get the OnAction property. Just don't forget to do a string search for "!" and change the workbook name prior to the procedure name, or else it will try to open the workbook originally referenced every time it's called.

justme
01-23-2006, 01:33 PM
Why is it that when I manually copy/paste the button comes over along with the link to the original module, but it won't when I use code? I'd be willing to put a spreadsheet in a shared directory so every worksheet would reference the module in that sheet. But I can't get the button to come over.

Any ideas?

Thanks for your original reply Firefytr. You're just so far advanced to my understanding that I didn't understand what you said.:bug: I keep trying though!

Zack Barresse
01-23-2006, 03:07 PM
You could always try creating the button programmatically. Try doing this recording a macro so you can get the source code. Then just work on making it reference the right workbook.

Shazam
01-23-2006, 03:21 PM
See if this helps.

Sub Assign_Macro()
'The name of your button "Filename.xls!Name of your macro"
.Add(280.5, 48.75, 72, 72).OnAction = "File.xls!MyMacro"
End Sub

Shazam
01-23-2006, 04:06 PM
Hi Zack. I'm getting all balled up in this workbook. I have 60+ workbooks out there that will have to be sent to me monthly (timesheets). Then the active worksheet has to be sent to their manager. I have all this done in code, the big problem is:

When I copy only a section of a worksheet it does not bring over the button and macro I have made for the manager to send it to HR. I figured out how to copy button 4, but the assigned macro did not come with it. I've been pulling my hair out for a week.


Opps I forgot something.




Sub Assign_Macro()



With ActiveSheet.Buttons
'The name of your button "Filename.xls!Name of your macro"
.Add(280.5, 48.75, 72, 72).OnAction = "File.xls!MyMacro"
End With
End Sub

justme
01-25-2006, 07:06 AM
Good morning. I wrote this in outlook and now I see a new post from Shazam- thank you! My question is still valid because I need to know how to "get back to" the original workbook after pasting in the new workbook.

I've been working with the code and I [think] I see how it can reference the module. I went back to the original code tried it and found that after I paste all the other info, I need to get back to the original document. So, I tried to dim dest1 and a dest2 as Workbook. When I try to Set dest2 = "Persons Name2006.xls" I get a compile error: Type mismatch.

How do I get back to the original file?

justme
01-25-2006, 07:53 AM
I see I can call out the specific file name with Windows.("name of file.xls").activate, but can I generically go back and forth to previous window?

If I reference the specific file name, which I am now, it doesn't want to go back to dest1 sheet.

Windows("My name2006b.xls").Activate
ActiveSheet.Shapes("button 4").Select
Selection.Copy
Windows.dest1.Activate
Cells(1).PasteSpecial all
Selection.OnAction = "'my name2006b.xls'!Mail_Range"

Zack Barresse
01-25-2006, 08:53 AM
Set dest2 = "Persons Name2006.xls"

Should be..

Set dest2 = Workbooks("Persons Name2006.xls")

justme
01-25-2006, 08:53 AM
ok, I got it working, but when opening the workbook you now get the notice that it references another workbook. How hard is it to copy the module into the new workbook (by code)? Going back to the beginning- what did you mean by:

"Hey Justme, you have to set a reference to Microsoft Visual Basic for Applications Extensability 5.3"

Thanks for your patience. I'm really trying to get this right.

We overlapped, just saw your message. I got around "dimming" both sheets by just saying dest1.activate when I had to get back to it. So technically, the code is working, but not as clean as if I could get the module attached to the dest1 worksheet, which is why I went back to asking about the original post and setting the referece you mentioned above.

Thanks so much Zack.

justme
01-27-2006, 08:27 AM
Hello all,

I've been diligently working to make this work and it close. My only problem now is having the button reference the module in the NEW workbook. On my first try it was referencing the module in the original document. Then I changed some things around (brought the file .saveAs up before the Selection.OnAction and which you can see I called to be This workbook name. When the workbook gets emailed and I check the button assignment it goes to 'C:\Documents and Settings\JustMe\Local Settings\Temporary Internet Files\OLK2B\This workbook.name'!Mail_Range

Here is some of the code
dest2.Activate
ActiveSheet.Shapes("button 4").Select
Selection.Copy
dest1.Activate
With dest1
.SaveAs "HR Copy " & ThisWorkbook.Name
End With
Cells(12557).PasteSpecial all
Selection.OnAction = "'ThisWorkbook.name'! Mail_Range"
strdate = Format(Now, "dd-mm-yy h-mm-ss")
Cells(54, 8).Select
With dest1
'.SaveAs "HR Copy " & ThisWorkbook.Name _




Here is the entire module.
Sub Mail_012706()
Dim source As Range
Dim dest1 As Workbook
Dim strdate As String

Set source = Nothing
On Error Resume Next
Set source = Range("A55:K109").SpecialCells(xlCellTypeVisible)

On Error GoTo 0
If source Is Nothing Then
MsgBox "The source is not a range or the sheet is protect, please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
Set dest2 = ActiveWorkbook
'Set dest1 = Workbooks.Add(xlWBATWorksheet)

Dim FName As String
Dim VBComp As VBComponent
Dim wbnew As Workbook
Dim x As String
'x = InputBox("wb name is", "wb to open")
Set wbnew = Workbooks.Add
'wbnew.SaveAs x
Set dest1 = ActiveWorkbook
dest2.Activate
With ActiveWorkbook
FName = .Path & "\code.txt"
If Dir(FName) <> "" Then
Kill FName
End If
For Each VBComp In .VBProject.VBComponents
If VBComp.Type <> vbext_ct_Document Then
VBComp.Export FName
wbnew.VBProject.VBComponents.Import FName
Kill FName
ElseIf VBComp.Name = "ThisWorkbook" Then
If VBComp.CodeModule.CountOfLines > 0 Then
wbnew.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString _
VBComp.CodeModule.Lines(1, VBComp.CodeModule.CountOfLines)
End If
End If
Next VBComp
End With
source.Copy
dest1.Activate
With dest1.Sheets(1)
'.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 and higher
' If you use Excel 97 use the other example
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
ActiveWindow.DisplayGridlines = False
End With
dest2.Activate
ActiveSheet.Shapes("button 4").Select
Selection.Copy
dest1.Activate
With dest1
.SaveAs "HR Copy " & ThisWorkbook.Name
End With
Cells(12557).PasteSpecial all
Selection.OnAction = "'ThisWorkbook.name'! Mail_Range"
strdate = Format(Now, "dd-mm-yy h-mm-ss")
Cells(54, 8).Select
With dest1
'.SaveAs "HR Copy " & ThisWorkbook.Name _
.SendMail "justme@xxx.com", _
"Timesheet attached"


.Close False
End With
Application.ScreenUpdating = True
End Sub





PLEASE HELP!

XLGibbs
01-27-2006, 12:08 PM
The reason you see that link is that when it is stored in the email temporary directory, and opened, that IS the location of the file...temporarily..

ThisWorkbook.Name in a string as you have done may need to be parsed to capture the actual ThisWorkbook.Name (otherwise the text ThisWorkbook.name will appear)

Although I read the above, i did not test all code in the thread...this is just what jumped out at me...

Selection.OnAction = "'" & ThisWorkbook.name & ""!Mail_Range"


Note that the ' is between the " " opposite the &

justme
01-27-2006, 12:18 PM
Thank you, thank you for looking at my post.

I put that code in but it comments out everything after the ' behind ThisWorkbook.Name. I tried putting quotes around it but then I got a compile error - Expected: end of statement.


Selection.OnAction = "'" & ThisWorkbook.Name & "'""!Mail_Range"


This modification gives me Run-Time error'1004: Unable to set the OnAction property of the Picture class.

XLGibbs
01-27-2006, 06:53 PM
oops extra quotes in there... before the !

Selection.OnAction = "'" & ThisWorkbook.Name & "'!Mail_Range"

justme
01-30-2006, 10:21 AM
Hello all, this code is not working. The button still references the original workbook module, not the one in the new workbook. When the receiver opens the workbook they get a warning that it contains links to another workbook and asks if they want to update.


I was just wondering if it is possible to have an "on open" event and then assign the macro to a button? Just a thought. That way the original workbook is long gone. Doable?

XLGibbs
01-30-2006, 10:31 AM
That is a formula warning, and would not be an issue for the macro assignments being in another workbook. If the macro assignment is incorrect, the other file would open before the macro would run (or try to).

Double check named ranges and such to make sure that all external references are removed (note: pastespecial values on the sheet itself will not remove named range references that are external, even if they are not used anywhere on the worksheet...)

Shazam
01-30-2006, 11:48 AM
Try these.


With ActiveSheet.Buttons
'The name of your button "Filename.xls!Name of your macro"
.Add(280.5, 48.75, 72, 72).OnAction = ActiveWorkbook.Name & "!Mail_Range"
End With

Or


Selection.OnAction = ActiveWorkbook.Name & "!Mail_Range"

justme
01-30-2006, 12:52 PM
HAPPY DANCE!!!

The selection.OnAction = ActiveWorkbook.Name & "!mail_range" worked!!

The ThisWorkbook terminology kept going back to the original file - don't understand why, it didn't read like it would do that.

I can't thank everyone who helped enough.

Shazam
01-30-2006, 01:15 PM
Glad to hear everything is fine now.
Cheers everyone:beerchug:

justme
02-01-2006, 05:51 AM
The other computers don't trust the code. I sent it out to two of the end users. I made sure the Microsoft Visual Basic for Applications Extensibility 5.3 was checked in their workbookbooks. When they click on the button which has the code above they both got the same error code:

Run'1004'
Programmatic access to Visual Basic Project is not trusted.

Why would this happen? The code works great on my computer.

Shazam
02-01-2006, 06:30 AM
Follow this you need to do this for each user:

In Excel Go to TOOLS_MACROS_Security
Then click on the tab that says TRUSTED PUBLISHERS
Then check mark on Trust access to Visual Basic Prodject.

justme
02-01-2006, 10:05 AM
That worked great. Thanks again.