PDA

View Full Version : Solved: Invoking the excel saveas screen



pico
11-23-2006, 09:37 AM
I'd like to invoke the excel save as screen from a macro and move 2 sheets from the current workbook into a new file. The new file shall be named from the save as screen.

CBrine
11-23-2006, 09:58 AM
pico,
Here's the code you require. Modify the copy sheets name and run it. It will add the new workbook and prompt for a save.

HTH
Cal


Dim wb As Workbook
Dim pb As Workbook
Set wb = ActiveWorkbook

Set pb = Workbooks.Add
wb.Sheets("Sheet1").Copy , pb.Sheets(1)
wb.Sheets("Sheet2").Copy , pb.Sheets(1)
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
Set pb = Nothing
Set wb = Nothing

austenr
11-23-2006, 10:06 AM
Not sure if you want the macro to automatically save the sheets, if you do more info is needed. As for the saveas I think this is what you are looking for:

Sub Savefiles()
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
End Sub

pico
11-23-2006, 11:10 AM
Great thanks guys. I will give this a try. Cheers:beerchug:

pico
11-23-2006, 11:17 AM
austen: What would i include in the file filter?The code you supplied invokes the screen. But when i type a file name and press save. I cant see the file being created.

CBrine
11-23-2006, 11:31 AM
Pico,
Austenr's code will only pull up a non functional dialog that allows you to put a name in. It doesn't actually do anything, you need to code the copy and save.

My code will copy the 2 sheets you need as well as open a fully functional saveas dialog, which works just like the saveas option in the file menu.

HTH
Cal

pico
11-23-2006, 11:32 AM
I'd like to save 2 sheets from the workbook that's active. The names of the two sheets are JOB_SPEC_FORM and PARTS1. When a command button is activated from a macro i'd like the save as screen to be displayed. Once the user enters a name and presses the save button i'd like to copy the two sheet from the current workbook to the new workbook created. It would be better if the new workbook created is closed. I dont need to see the information being saved. Just hit save and copy the sheets over to the file created.

pico
11-23-2006, 11:33 AM
Iam trying your code at the moment Cbrine. It does not seem to copy the sheets over to the file.

CBrine
11-23-2006, 11:43 AM
Pico,
Did you change the names as I instructed?
Your final code needs to look like this.

My code adds a new workbook, copies the two sheets, activates the new workbook with the two sheets, and presents you will a saveas screen. I've added code to close the new workbook as well.
THE CLOSE HAS NO INTELLIGENCE, so if cancel is pressed the new workbook will not be saved, and the workbook will still close.
If save is press in the dialog the file will save as normal.


Dim wb As Workbook
Dim pb As Workbook
Set wb = ActiveWorkbook

Set pb = Workbooks.Add
wb.Sheets("JOB_SPEC_FORM ").Copy , pb.Sheets(1)
wb.Sheets("PARTS1").Copy , pb.Sheets(1)
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
pb.close false
Set pb = Nothing
Set wb = Nothing


HTH
Cal

pico
11-23-2006, 12:09 PM
tHANK YOU CBRINE. This is what i was looking for. Cheers:beerchug:

pico
11-23-2006, 02:18 PM
The save as screen takes about 30 seconds to load. I think the copy function takes too much time to copy over the sheets. Can i copy a range of cells in a sheet to another workbook instead? Is this possible? Also the sheet i want to copy has a macro. Is there a function where i could only copy the information on the sheet and not the macro over?.

CBrine
11-23-2006, 03:04 PM
pico,
Your suggestion on the range of cells copy will take care of both issues. What are the sheets and the ranges you need to copy?
And are they dynamic or static ranges?
If they are dynamic give me the column ranges(ie. A:X) and a column that will always be populated to the last row. This always populated column will be used to determine the last used row for the entire table and to determine the copy area.

Cal

pico
11-23-2006, 03:13 PM
There are dynamic values in the sheets. But the M column is static always in both the sheets. In the Job_Spec_form the range is A175:M175, the range for Parts1 sheet is A114:M114. Thank you

CBrine
11-24-2006, 07:13 AM
Pico,
These revisions should fix you up.


Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
ws1.Range("A1", ws1.Range("M" & ws1.Rows.Count).End(xlUp)).Copy ps1.Range("A1")
ws2.Range("A1", ws2.Range("M" & ws2.Rows.Count).End(xlUp)).Copy ps2.Range("A1")
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False

set ps1=nohting
set ps2=nothing
set wb1=nothing
set wb2 =nothing
Set pb = Nothing
Set wb = Nothing

pico
11-24-2006, 07:44 AM
I tried the code you supplied. It does not copy the sheets over properly. I have attached the Job_spec_form file. Let me know if you can get it working

CBrine
11-24-2006, 08:21 AM
OK,
Give this a try.


Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
ws1.Cells.Copy ps1.Range("A1")
ps1.Activate
ActiveWindow.DisplayGridlines = False
ws2.Cells.Copy ps2.Range("A1")
ps2.Activate
ActiveWindow.DisplayGridlines = False
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False

Set ps1 = Nothing
Set ps2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Set pb = Nothing
Set wb = Nothing

austenr
11-24-2006, 08:46 AM
That works for me with some modifications. Since the example did not contain the sheet ("PARTS1") you have to comment out that line and where it is referenced later in the code. I put the code in a module and not in the sheet.

pico
11-24-2006, 08:47 AM
The code works almost perfectly. Just a question though. Is there any way i can move the checkmarks from the jobspec form to my new sheet?..or is that going to slow down the process?

CBrine
11-24-2006, 09:07 AM
pico,
Copying the checkbox will add to the processing time for sure. Here's some code, give it a try and see how long. For me, the complete copy process took only 3 seconds. I just added screen updating disabling code, which might speed it up a bit.


Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim s As Shape
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
'Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)

application.screenupdating = false
ws1.Cells.Copy ps1.Range("A1")
ps1.Activate
ActiveWindow.DisplayGridlines = False
For Each s In ws1.Shapes
If s.Type = 12 Then
s.Copy
ps1.Paste
End If
Next s
'ws2.Cells.Copy ps2.Range("A1")
'ps2.Activate
'ActiveWindow.DisplayGridlines = False
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False

application.screenupdating = true
Set ps1 = Nothing
Set ps2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Set pb = Nothing
Set wb = Nothing

pico
11-24-2006, 09:13 AM
Thank you Cbrine and austen for all the help. You guys are awesome:beerchug: . I guess the copy time does take a bit longer than i wanted, but iam assuming this is the best solution so far. Anyway, iam marking this thread as solved. Thanks for all the help. :bow:

pico
11-24-2006, 09:27 AM
As always i come back to a solved thread. Instead of invoking the saveas screen can excel just write to the file and stamp the date and time the file was saved on to the filename?. I came across a loophole where a user could hit cancel and the file might not be saved. :bug:. The location of the file to be saved is a folder in desktop.

CBrine
11-24-2006, 09:41 AM
pico,
This will force a save before allowing them to exit. They could most likely ctrl-break out of it, but no other way.


Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim s As Shape
Dim response As String

Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
'Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)

Application.ScreenUpdating = False
ws1.Cells.Copy ps1.Range("A1")
ps1.Activate
ActiveWindow.DisplayGridlines = False
For Each s In ws1.Shapes
If s.Type = 12 Then
s.Copy
ps1.Paste
End If
Next s
'ws2.Cells.Copy ps2.Range("A1")
'ps2.Activate
'ActiveWindow.DisplayGridlines = False
pb.Activate
Application.ScreenUpdating = True
response = "False"
Do Until response <> "False"
Application.Dialogs(xlDialogSaveAs).Show
Loop
pb.Close False

Set ps1 = Nothing
Set ps2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Set pb = Nothing
Set wb = Nothing


PS-If you want to hard code the save path, that is of course possible, but I figure you must have a reason for asking for the dialog originally.

HTH
Cal

austenr
11-24-2006, 09:49 AM
Rats you beat me too it. :thumb

pico
11-24-2006, 09:49 AM
If i press the save button it saves the file ..but the saveas screen does not close. It keeps looping!:whistle:

CBrine
11-24-2006, 09:52 AM
pico,
Forgot to put my variable into the dialog show.

Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim s As Shape
Dim response As String

Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
'Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)

Application.ScreenUpdating = False
ws1.Cells.Copy ps1.Range("A1")
ps1.Activate
ActiveWindow.DisplayGridlines = False
For Each s In ws1.Shapes
If s.Type = 12 Then
s.Copy
ps1.Paste
End If
Next s
'ws2.Cells.Copy ps2.Range("A1")
'ps2.Activate
'ActiveWindow.DisplayGridlines = False
pb.Activate
Application.ScreenUpdating = True
response = "False"
Do Until response <> "False"
response = Application.Dialogs(xlDialogSaveAs).Show
Loop
pb.Close False

Set ps1 = Nothing
Set ps2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Set pb = Nothing
Set wb = Nothing

pico
11-24-2006, 11:02 AM
Great it works. Thank you: pray2:

pico
12-01-2006, 09:00 AM
Hi CBrine, Hope you are still using this forum :bug:
Got some issues with my code. This is the last code that you supplied. There have been some changes to the form i created. I have added a label with a circle in the jobspec form as well. If you scroll down you will be able to see them when you are in design mode.

Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim s As Shape
Dim response As String

Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)

Application.ScreenUpdating = False
ws1.Cells.Copy ps1.Range("A1")
ps1.Activate
ActiveWindow.DisplayGridlines = False
For Each s In ws1.Shapes
If s.Type = 12 Then
s.Copy
ps1.Paste
End If
Next s
ws2.Cells.Copy ps2.Range("A1")
ps2.Activate
ActiveWindow.DisplayGridlines = False
pb.Activate
Application.ScreenUpdating = True
'response = "False"
'Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
'Loop
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False

Set ps1 = Nothing
Set ps2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Set pb = Nothing
Set wb = Nothing

I have attached my worksheet as well. When i do the save right now It copies the circles. But they are all the way on top of the copied sheet. Not where i want them to be basically. How can i correct this problem?:think:

lucas
12-01-2006, 09:30 AM
Rats you beat me too it. :thumb
I love this forum....folks trying to be the first with a solution!

pico
12-01-2006, 11:04 AM
Can anyone give me a solution to this problem?

CBrine
12-01-2006, 11:23 AM
Hey pico,
I'm assuming you are referring to the groups of 3 circles around

pico
12-01-2006, 11:37 AM
Yes Groups of 3 circles. There should be 3 for each floor. They are control toolbox labels

CBrine
12-01-2006, 01:31 PM
Pico,
I'm not sure what is going on it seems like some of the shape objects are corrupted. As soon as I cut and paste them again. The copy seems to work on them? I've attached a copy of the what I did. You are going to need to cut and paste the circle labels back in again.

HTH
Cal

pico
12-01-2006, 02:10 PM
I have the same problem. It does not seem to work for some reason. The type that you specify in vba does that include labels as well? s.type=12 .

CBrine
12-01-2006, 02:22 PM
Yeah, That's the first thing I checked on. The checkbox's and labels are both type =12.

When I ran the code on my machine, I had some checkbox's not copy correctly as well.
Seems pretty strange, I'm not sure what's occurring.
Have you tried the cut and paste trick I mentioned? The code seems to work after they have been cut and pasted?

Cal

PS- I also checked the format, and properties of ones that copied OK vs the ones that didn't and I was not able to see a difference.

pico
12-01-2006, 02:58 PM
I tried using the cut and paste method. It still does not seem to work.

pico
12-02-2006, 06:02 PM
Ok this is a problem. Instead of saving an excel file i'd like to export the data to a pdf file instead? Is this possible? It does not need to be an excel file the one thats saved. Since this approach is not working i'd like to try exporting my excel sheet to a pdf. How can i achieve this?

CBrine
12-03-2006, 07:38 PM
pico,
Trying to export to pdf using vba automation, I believe is impossible, since you would need to somehow call the program that convets to pdf. Excel doesn't save to that format natively.
I'm thinking at this point we may want to go back to the original copy of the entire worksheet, and programmatically remove the code that is transferred with it. I can't do much right now, since I'm at home, but should have some time to look at it on Monday.

Cal

pico
12-04-2006, 09:50 AM
Ok. Also i wanted to add another variation to the code. Copy to the second sheet only if the checkbox is ticked and only if the labels are visible. Else dont copy the object. . I think this might considerably speed up the process as well. I dont need to look at the objects that are not selected. Just thought that i might add that in there. Btw. I dont have a previous copy of the workbook. I have been working with the same workbook since the start. Pretty much overwriting it.

CBrine
12-06-2006, 11:01 AM
pico,
I made some adjustments and revised the entire code. Now it copies the entire worksheet once again, and it removes the code that is copied with it. Give it a try and let me know.


Sub CopyData()
Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws As Worksheet
Dim pb As Workbook, ps As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Set pb = Workbooks.Add
ws.Copy pb.Sheets(1)
Set ps = ActiveSheet
With pb.VBProject.VBComponents(ps.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
response = "False"
Do Until response <> "False"
response = Application.Dialogs(xlDialogSaveAs).Show
Loop
pb.Close False
End Sub

pico
12-07-2006, 06:31 AM
I included the second sheet copy in there as well. But there seems to be some problems. The ws.Copy pb.Sheets(1) code does not work. Cant figure out what the problem is.

Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
ws1.Copy pb.Sheets(1)
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
With pb.VBProject.VBComponents(ps1.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
ws2.Cells.Copy ps2.Range("A1")
ps2.Activate
ActiveWindow.DisplayGridlines = False
'response = "False"
' Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
' Loop
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False

pico
12-07-2006, 06:54 AM
Nevermind. Figured it out. Thanks. Works good so far. I had the sheets hidden as veryhidden. I dont think it works with the sheets veryhidden.

pico
12-07-2006, 07:26 AM
Ok Problemos. The code that you supplied works when the sheet is not hidden. As soon as i hide the sheet it wont copy. I tried hiding the sheet in excel and also coding it.

CBrine
12-07-2006, 09:32 AM
So, the sheet is hidden when the code needs to execute? Just add the unhide code to the start of the code.
sheets("NEW_JOB_CODES").visible = false

and hide it again at the end of the code.

sheets("NEW_JOB_CODES").visible = xlsheetveryhidden

HTH
Cal

pico
12-07-2006, 09:58 AM
I tried that and it works. But When i open the saved file again. It updates itlself with the values from the original workbook. I do not want any updating done when i open the saved file. The code right now looks like this

Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Set wb = ActiveWorkbook
Sheet1.Visible = xlSheetVisible
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Application.ScreenUpdating = False
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
ws1.Copy pb.Sheets(1)
With pb.VBProject.VBComponents(ps1.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
ws2.Cells.Copy ps2.Range("A1")
ps2.Activate
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = True
'response = "False"
' Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
' Loop
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False
Sheet1.Visible = xlSheetHidden

austenr
12-07-2006, 10:05 AM
Do you need the code in the saved file for future use? If not you might want to just delete the code in the saved WB. Does it do the updating first thing when you open the newly saved WB? If so move it out of the Workbook Open and put the code in a general module. Just a guess.

pico
12-07-2006, 11:10 AM
No i do not need the code in the saved file. All i need is the values that were copied. Yes it updates as soon as i open the saved file. I dont understand what you mean by move the code from workbook open. The saving is automated. The saved file should have no code and should not update.

austenr
12-07-2006, 11:13 AM
If the saved file updates as soon as you open it then the code may be in the wrong place. Can you post the WB for us to look at? Sanitize any sensitive data first. I suspect that the code is in the wrong module.

CBrine
12-07-2006, 11:35 AM
austenr,
I don't think we are dealing with event level code on his part. It's just a subroutine that he runs to copy the worksheet, and saves it as a different filename.
'course that leads to the question of just what he's talking about when he says he opens the saved copy and it updates to the same values as the other workbook. I'm thinking the issue maybe linked formula's, since the copy he gave me asked to update when I opened it. I might need to do the cell.copy->Vallues as well, after the worksheet copy.

Pico,
If I copy and paste values, you will lose all formula's in the worksheet, is that OK?

Cal

pico
12-07-2006, 11:52 AM
Yup that's fine. I do not need the formulas in the saved file. Just values copied over from the original workbook.

austenr
12-07-2006, 11:53 AM
CB,

OK. Then paste values only should work. That part about when it opens it changes immediatly made me think of Worksheet Change event.

CBrine
12-07-2006, 01:50 PM
pico,
Hopefully this one will fix you up.:-)


Sub CopyData()
Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws As Worksheet
Dim pb As Workbook, ps As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Sheet1.Visible = xlSheetVisible
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Set pb = Workbooks.Add
ws.Copy pb.Sheets(1)
Set ps = pb.ActiveSheet
ws.Cells.Copy
ps.Cells.PasteSpecial xlPasteValuesAndNumberFormats
Set ps = ActiveSheet
With pb.VBProject.VBComponents(ps.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
response = "False"
Do Until response <> "False"
response = Application.Dialogs(xlDialogSaveAs).Show
Loop
pb.Close False
Sheet1.Visible = xlSheetHidden
End Sub


HTH
Cal

pico
12-07-2006, 04:43 PM
Sorry CBrine. When i mentioned that the worksheet updates itself. I meant the Parts1 sheet updates itself. I was not talking about the Job_Spec_form sheet. The Job spec form sheet copies perfectly with the previous method. Parts1 sheet is the one with the formulas.

CBrine
12-08-2006, 09:14 AM
Pico,
OK, that should be simple as this.

Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Set wb = ActiveWorkbook
Sheet1.Visible = xlSheetVisible
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Application.ScreenUpdating = False
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
ws1.Copy pb.Sheets(1)
With pb.VBProject.VBComponents(ps1.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
ws2.Cells.Copy ps2.Range("A1")
ws2.Cells.Copy
ps2.Cells.PasteSpecial xlPasteValuesAndNumberFormats
ps2.Activate
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = True
'response = "False"
' Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
' Loop
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False
Sheet1.Visible = xlSheetHidden

pico
12-11-2006, 06:12 AM
I get an error "pastespecial method of range class failed". Cant really figure out what the problem is. Btw iam using excel 2000.

CBrine
12-11-2006, 08:40 AM
pico,
Can you upload a copy of your sheet? It's going to be difficult to determine what the problem is otherwise?

Cal

pico
12-11-2006, 09:02 AM
I have attached the PARTS1 sheet. The other sheet was included earlier

pico
12-11-2006, 11:07 AM
Ok I came up with some changes to the code. It prints the values that i want in the Parts sheet without formulas. But there are a few changes i need. 1. I'd like the row height of the original copied over to the second sheet. At the moment I tried using the paste special method. It does not seem to work. The column width works perfectly. 2. When i open the saved file i still get the enable macro screen on startup. I thought iam deleting all the code. Just wondering why that's happening. :think: . Here is the code.

Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Set wb = ActiveWorkbook
'Sheet1.Visible = xlSheetVisible
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Application.ScreenUpdating = False
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
ws1.Copy pb.Sheets(1)
With pb.VBProject.VBComponents(ps1.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
ws2.Range("A1:E10").Cells.Copy ps2.Range("A1:E10")
ws2.Range("A11:E75").Cells.Copy
ps2.Range("A11:E75").Cells.PasteSpecial (xlPasteFormats)
ps2.Range("A11:E75").Cells.PasteSpecial (xlPasteValues)
ps2.Range("A11:E75").Cells.PasteSpecial (8) 'copy column width
ps2.Range("A11:E75").Cells.PasteSpecial (xlrowheight) 'copy row width
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = True
'response = "False"
' Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
' Loop
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False
'Sheet1.Visible = xlSheetHidden

CBrine
12-11-2006, 11:47 AM
I changed the copy and paste method to the entire workbook, added the copy paste values, and setup code to remove the code from the PS2 modules.


Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Set wb = ActiveWorkbook
'Sheet1.Visible = xlSheetVisible
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Application.ScreenUpdating = False
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
ws1.Copy pb.Sheets(1)
With pb.VBProject.VBComponents(ps1.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
ws2.Copy pb.Sheets(1)
ws2.Range("A11:E75").Cells.Copy
ps2.Range("A11:E75").Cells.PasteSpecial (xlPasteValues)
With pb.VBProject.VBComponents(ps2.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = True
'response = "False"
' Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
' Loop
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False
'Sheet1.Visible = xlSheetHidden


Let me know if this works.

Cal

pico
12-11-2006, 02:45 PM
I tried your code. But there seem to be a couple problems there. I have updated it to look like the following . Iam going to attach the saved file. This is what is output after i hit the save button. There are still a couple of problems with this that i cannot seem to fix. It tries to update itself from the original file when i try to open it.2. The copy works but there is an empty sheet in between the Parts1 and teh JobSpecForm sheet. My code looks like this:
Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Application.ScreenUpdating = False
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
Sheet1.Visible = xlSheetVisible
ws1.Copy pb.Sheets(1)
Sheet1.Visible = xlSheetHidden
'ws2.Range("A1:E10").Cells.Copy ps2.Range("A1:E10")
ws2.Range("A1:E75").Cells.Copy
ps2.Range("A1:E75").Cells.PasteSpecial (xlPasteFormats)
ps2.Range("A1:E75").Cells.PasteSpecial (xlPasteValues)
ps2.Range("A1:E75").Cells.PasteSpecial (8) 'copy column width
ps2.Rows(2).RowHeight = ws2.Rows(2).RowHeight 'copy 2nd row height
ps2.Rows(4).RowHeight = ws2.Rows(4).RowHeight 'copy 4th row height
ps2.Rows(6).RowHeight = ws2.Rows(6).RowHeight 'copy 6th row height
ps2.Rows(8).RowHeight = ws2.Rows(8).RowHeight 'copy 8th row height
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = True
'response = "False"
' Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
' Loop
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False

This is ****ing me off. Iam getting frustrated with VBA:banghead:

pico
12-11-2006, 02:47 PM
f

pico
12-11-2006, 02:51 PM
saved file

CBrine
12-11-2006, 07:48 PM
Pico,
OK, so your first issue is where the sheets are pasted. The reason they are getting pasted out of order is that you are copying the entire workbook for the job_spec_sheet, and you have assigned the worksheets prior to that?? If you want my help you need to use the code that I've modified. If you look at the last post I gave you, it's coded the correct way. The way yours is coded you end up trying to remove code from a sheet without code in, and just ignore the sheet with the code.

Second issue, is the update link that keeps appearing. I've reviewed the workbook you attached, and the reason you are getting this, is because you have checkboxes with linked cells still attached to some sheet called
release.xls. Do these link cells need to be there? If not, remove them from the master copy of your workbook. To be sure they are all removed, just goto the excel menu
edit.....links
if they are all gone the links option should be grayed out.

Third,
Is there a reason why you can't upload the workbook that you are producing the sheet with? I'm trying to determine what's going on by looking at your output. This would be much easier to troubleshoot with the actual workbook that is used to produce the output sheet. That way, I could make the necessary corrections, and post it back to the thread.


Cal

pico
12-12-2006, 06:12 AM
Cal,
I cant upload my original workbook because the filesize is around 2MB. This forum supports around 300kb?. I do need the links in the original workbook. I use them to calculate the partnumbers in another sheet. Is there a way of copying the checkboxes without the links attached?. Please rememeber that i do need them in my original. The code that you supplied at the moment did not work like i wanted it. For example it created 2 parts sheets for me in the saved file.I will try to look at the code that you have supplied me and try to work around it. Btw, i thank you for all the help you have given me so far.:friends:

lucas
12-12-2006, 07:21 AM
pico, can you zip up the file and reduce its size enough to be able to upload it?

CBrine
12-12-2006, 07:33 AM
pico,
I will PM you my hotmail account address, send it there. This will make the process much easier.

Cal

lucas
12-12-2006, 07:40 AM
Hang in the Cal....your doing a heck of a job....seriously

pico
12-12-2006, 07:41 AM
I have emailed the file to Cal.

pico
12-12-2006, 07:51 AM
I was having problems sending it through gmail. Sent it through hotmail instead.

pico
12-12-2006, 07:52 AM
This is an automatically generated Delivery Status Notification.Delivery to the following recipients failed. (http://by106fd.bay106.hotmail.msn.com/cgi-bin/compose?curmbox=00000000-0000-0000-0000-000000000001&a=187a5d2939da4f86308730c783367caed8f2104ddfc11429a36301b5cf7a270a&mailto=1&to=Calvin.brine@hotmail.com&msg=B0FBE2A6-4130-40FF-A849-133ED19705F7&start=0&len=670730&src=&type=x)Ithere something wrong with your email Address>??? HOtmail did this as well

pico
12-12-2006, 07:53 AM
sorrry didnt mean to post your email here. DOH

CBrine
12-12-2006, 08:29 AM
No worries,
Not like I'm going get any extra junk mail in my hotmail account.

OK,
I've got your workbook, and I've figured out where the code is.
I've resolved the copy issue on ps2, and removed the formula's from the final sheet. My copy is getting some NA errors, but I'm assuming that's because I'm bypass the normal population method to run it. I've also removed some blank events from the job_spec_sheet that were causing the enable macro's message to appear, which eliminates the need to erase the methods programmatically.

NEXT PROBLEM TO RESOLVE

That the last problem is the request to update links. These are appearing because you have checkboxes linked to your other workbooks(In the release.xls workbook) using the linkedcell property for the checkboxes.

Are those links needed? If they are needed, then I will need to do some research to figure out how to copy the checkboxes without the linked cell property, and keep the current state of the checkbox.

Let me know.

Cal

pico
12-12-2006, 08:31 AM
Yes, I did mention in my previous post that the links were needed in the original sheet. There are being used to calculate the partnumbers in the second sheet of the orginal workboook

CBrine
12-12-2006, 08:40 AM
So in the copied sheet we need to have the checkbox state, but not the link? and we need to leave the original as it is. OK, let me look into that.

Cal

CBrine
12-12-2006, 09:10 AM
pico,
I think we are finally there. I was able to remove the linkedCell property without changing the state of the checkbox. I was then able to open the final produced workbook without the enable macro's and without the update links.
I've sent the zip file to your hotmail account. Let me know if this takes care of the problems.

Cal

PS-A very well put together wizard by the way.

pico
12-13-2006, 08:08 AM
Thank you Cal. Exactly what i needed. Finally i can say iam done with this project. I appreciate your help very much. Btw iam glad you like the design. I was going for a professional look. In the end i think it came out pretty good. Not too bad for a first timer with VBA. Thanks again. Cheers:beerchug: . HAHA..i can finally close this message.

CBrine
12-13-2006, 08:22 AM
Pico,
Glad everythings working now. You were looking for some out of the ordinary stuff, which is why it took so long to come up with a solution.

Thought I would post the finalized code, just in case anyone else has to deal with something similiar.


Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Dim s As OLEObject

'Set references to the Master workbook
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
'Add new workbook
Set pb = Workbooks.Add
Application.ScreenUpdating = False
'Unhide job_spec_form
Sheet1.Visible = xlSheetVisible
'Copy data from first sheet, set reference to it and hide original workbook again.
ws1.Copy pb.Sheets(1)
Set ps1 = ActiveSheet
Sheet1.Visible = xlSheetHidden
'cycle through shapes and remove link
For Each s In ps1.OLEObjects
If Left(s.Name, 6) = "CheckB" Then
s.LinkedCell = ""
End If
Next s
'Copy data from second sheet, set references to it and copy and paste values
ws2.Visible = xlSheetVisible
ws2.Copy , pb.Sheets(1)
Set ps2 = ActiveSheet
ws2.Cells.Copy
ps2.Range("A1").PasteSpecial (xlPasteValues)
ws2.Visible = xlSheetVeryHidden
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = True
'response = "False"
' Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
' Loop
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False