PDA

View Full Version : Using hot button to export new Workbook



Woody19722
07-06-2012, 12:47 PM
I am currently using a workbook that has a hot button to save the current workbook into a new one. Listed be is the code:

Sub CopyMod()
Dim wkbSrc As Workbook, wkbDest As Workbook
Dim Btn As Button
Dim s As String

' set the source and destination workbooks
Set wkbSrc = Workbooks("MPO TOOL V7.1.0.xlsm")
Set wkbDest = Workbooks("Book1")

' get the code from the source module
With wkbSrc.VBProject.VBComponents("Module3").CodeModule
s = .Lines(1, .CountOfLines)
End With

' Create the destination module and copy the code
With wkbDest.VBProject.VBComponents.Add(1)
.Name = "SomeName"
With .CodeModule
If .CountOfLines > 0 Then .DeleteLines 1, .CountOfLines
.AddFromString s
End With
End With

'Set Btn = wkbDest.ActiveSheet.Buttons.Add(54.75, 32.25, 128.25, 61.5)
'With Btn
'.Caption = "Button Name" 'change the name of the button accordingly
'.OnAction = "msg"
'End With
End Sub


It crashes when you try to save it again, run-time error'9'. Subscript out of range. From my understanding it looks like it is trying to call it book2. This is creating a broken link because the code is trying to read book1. :dunno

CatDaddy
07-06-2012, 01:01 PM
Sub CopyMod()
Dim wkbSrc As Workbook, wkbDest As Workbook
Dim Btn As Button
Dim s As String

' set the source and destination workbooks
Set wkbSrc = Workbooks("MPO TOOL V7.1.0.xlsm")
Set wkbDest = Workbooks.Add

' get the code from the source module
With wkbSrc.VBProject.VBComponents("Module3").CodeModule
s = .Lines(1, .CountOfLines)
End With

' Create the destination module and copy the code
With wkbDest.VBProject.VBComponents.Add(1)
.Name = "SomeName"
With .CodeModule
If .CountOfLines > 0 Then .DeleteLines 1, .CountOfLines
.AddFromString s
End With
End With

'Set Btn = wkbDest.ActiveSheet.Buttons.Add(54.75, 32.25, 128.25, 61.5)
'With Btn
'.Caption = "Button Name" 'change the name of the button accordingly
'.OnAction = "msg"
'End With
End Sub

Woody19722
07-09-2012, 07:59 AM
The simple solution worked great. The problem is that now the workbook doesn't close after saving it. How can I correct this? Thank you for you assistance.

snb
07-09-2012, 08:50 AM
that has a hot button to save the current workbook into a new one
That's not what your code is performing.


Sub snb()

Workbooks("MPO TOOL V7.1.0.xlsm").VBProject.VBComponents("Module3").export "C:\test.bas"

with workbooks.add
.VBProject.VBComponents.import "C:\test.bas"
end with

End Sub

CatDaddy
07-09-2012, 10:20 AM
wkbkSrc.Close

snb
07-09-2012, 01:09 PM
amended suggestion:

Sub snb()
with Workbooks("MPO TOOL V7.1.0.xlsm")
.VBProject.VBComponents("Module3").export "C:\test.bas"
.close false
end with
workbooks.add.VBProject.VBComponents.import "C:\test.bas"
End Sub

Woody19722
07-16-2012, 10:20 AM
Sorry but I can't get that process to work. I am currently saving the file this way and it was closing the save file.

..............

Dim TheFile As Variant

TheFile = Application.GetSaveAsFilename("C:\Documents and Settings\All Users\Desktop\MerLOT Reports\Div-Loc_PxWx_MPO_Preview.xlsm", _
"Excel Macro-Enabled Workbook (*.xlsm), *.xlsm", , "SELECT LOCATION:")
If TheFile = False Then
MsgBox "SAVE FILE cancelled"
Else
MsgBox "Your copies will now be saved in the following path..." & vbNewLine & vbNewLine & CStr(TheFile)


ActiveWorkbook.SaveAs Filename:=TheFile, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close
.Close False



End If

.................