Automate file save as 1

[APElliott]

Hi,

I have some code that I been using to print hard copies from Pivot Tables.

I would now like to print the file as a 'Microsoft Office Document Imaging File'. However I would like some VB code that would automatical give the file save as name.

The file name is to be the first 4 characters of the original file + the text in cell L1 + the text in cell M1.

Thankyou,

Andy

 

[SkipVought]

Hi,

Have you tried turning on your Macro Recorder and doing it?

Skip,

_{[red]Be advised:[/red]We know Newton's 3 Laws. But did you hear about the [red]FOURTH???[/red]
Only ONE fig per cookie!}

 

[APElliott]

Thank for your response Skip!

I have tried Recording, but I didn't know how to change the code to so that it would name the file in the way as previously mentioned.

Cheers,

Andy

 

[SkipVought]

Post your recorded code.

Skip,

_{[red]Be advised:[/red]We know Newton's 3 Laws. But did you hear about the [red]FOURTH???[/red]
Only ONE fig per cookie!}

 

[APElliott]

Hi Skip,

Here my code:

ActiveWindow.SelectedSheets.PrintOut From:=1, To:=2, Copies:=1, _
PrintToFile:=True, Collate:=True
ActiveWorkbook.SaveAs Filename:= _
"\\server007\BConstruct\Estimating\Shared\Andy Elliott, Backups\02.Tenders\2005 Tenders\3405 Altrincham Grammar SChool\3405 01 Bulk Excavation" _

"Bulk Excavation" is the text in M1, "01" is the text in L1 & "3405" are the first 4 character of the excel file.

The code is made up of 2 bit of code I've tried to unsuccessfully stitch together.

Cheers,

Andy

 

[SkipVought]

    sPath = "\\server007\BConstruct\Estimating\Shared\Andy Elliott, Backups\02.Tenders\2005 Tenders\3405 Altrincham Grammar SChool"
    
    sName = Left(ActiveWorkbook.Name, 4) & " " & [M1] & " " & [L1]
    
    ActiveWorkbook.SaveAs Filename:= _
    sPath & "\" & sName & ".xls"

Skip,

_{[red]Be advised:[/red]We know Newton's 3 Laws. But did you hear about the [red]FOURTH???[/red]
Only ONE fig per cookie!}

 

[PHV]

Perhaps this ?
With ActiveWorkbook
.SaveAs Filename:=.Path & "\" & Left(.Name, 4) & " " _
& Range("L1") & " " & Range("M1")
End With

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[APElliott]

Hi Guys,

Thanks for your help guy's!

I don't think my code as help to explain myself - apologies!

I'll try and explain a bit better:

I have some code that currently prints from a pivot table (see below)

Now instead of printing hard copies I'd like to print '*.mdi' files.

However, when printing to the Microsoft Office Document Image it asks for a 'save as' name. This is the bit I'd like to automate. I don't want the 'save as' window to pop up, I'd like the code to automatically name the 'mdi' file as the first 4 character of the excel workbook + the text in cell L1 + the text in cell M1.

Cheers,

Andy

Code:

Sub PrintAllEnquires()
Application.ScreenUpdating = False
'Removal Any Subtotals From BoQ
Sheets("BoQ").Select
[a2].Select
Selection.RemoveSubtotal
Sheets("BoQ Prints").Select
'Update Any Rogue Data In The Fields
With Sheets("BoQ Prints").PivotTables("BillsOfQuantities").PivotCache
.MissingItemsLimit = xlMissingItemsNone
.Refresh
End With
ActiveSheet.PivotTables("BillsOfQuantities").PivotFields("Volume").AutoSort _
xlAscending, "Volume"
ActiveSheet.PivotTables("BillsOfQuantities").PivotFields("Page").AutoSort _
xlAscending, "Page"
ActiveSheet.PivotTables("BillsOfQuantities").PivotFields("Headers").AutoSort _
xlAscending, "Headers"
ActiveSheet.PivotTables("BillsOfQuantities").PivotFields("Sub Ref").AutoSort _
xlManual, "Sub Ref"
Dim R As Long
'Loop till R = 65
For R = 6 To 65
'Cells(RowNumber,ColNumber)
If Cells(R, 12).Value > 0 And Cells(R, 14).Value > 0 Then
Cells(1, 12).Value = Cells(R, 12).Text
Application.ScreenUpdating = True
Application.ScreenUpdating = False

'Show All in Sub Ref Column
For Each pit In ActiveSheet.PivotTables("BillsOfQuantities").PivotFields("Sub Ref").PivotItems
pit.Visible = True
Next

'Show the Sub Ref in Cell P1 now named "SelectEnquiry"
For Each pit In ActiveSheet.PivotTables("BillsOfQuantities").PivotFields("Sub Ref").PivotItems
With pit
If .Value = [SelectEnquiry].Value Then
.Visible = True
Else
.Visible = False
End If
End With
Next
'Show All in theMarkup Column
For Each pit In ActiveSheet.PivotTables("BillsOfQuantities").PivotFields("Markup").PivotItems
With pit
If .Value = ("(blank)") Or .Value = ("0") Then
.Visible = True
Else
.Visible = True
End If
End With
Next

Application.ScreenUpdating = False

'Refresh the data
ActiveSheet.PivotTables("BillsOfQuantities").PivotCache.Refresh
Application.ScreenUpdating = False
'Show All in Sub Ref Column again
For Each pit In ActiveSheet.PivotTables("BillsOfQuantities").PivotFields("Sub Ref").PivotItems
pit.Visible = True
Next
Application.ScreenUpdating = False
'Show the Pages only in the Markup column
For Each pit In ActiveSheet.PivotTables("BillsOfQuantities").PivotFields("Markup").PivotItems
With pit
If .Value = ("0") Then
.Visible = False
Else
.Visible = True
End If
End With
Next
Range("B5").Select
Selection.ShowDetail = False
Sheets("Enq").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=Sheets("BoQ Prints").Cells(R, 14).Value
Sheets("BoQ Prints").Select
Range("B5").Select
Selection.ShowDetail = True
'Run Format Macro
Application.Run "BoQFormat"
With ActiveSheet
.PageSetup.RightFooter = ([L1]) + (". ") + ([M1]) + (" ENQUIRY")
End With
Application.ScreenUpdating = False
'Print the enquiry

ActiveWindow.SelectedSheets.PrintOut Copies:=Cells(R, 14).Value, Collate:=True
End If

Next R

With ActiveSheet
.Outline.ShowLevels ColumnLevels:=1
End With
[a6].Select

Application.ScreenUpdating = True
End Sub

 

[SkipVought]

Here's a little test I just ran without any prompt for the PrintToName...

    ActiveSheet.PrintOut Copies:=1, PrintToFile:=True, Collate _
        :=True, PrToFileName:="D:\new_print_to_file.prt"

Skip,

_{[red]Be advised:[/red]We know Newton's 3 Laws. But did you hear about the [red]FOURTH???[/red]
Only ONE fig per cookie!}

 

[APElliott]

Skip,

Fantastic - that's just the trick!

I've altered the code as necessary and it works at treat:

Application.ActivePrinter = "Microsoft Office Document Image Writer on Ne00:"

ActiveSheet.PrintOut Copies:=1, PrintToFile:=True, Collate _
:=True, PrToFileName:=Left(ActiveWorkbook.Name, 4) & " " & [L1] & " " & [M1]



However, I've now added a bit to put it in the correct folder, but I can't get it to work:

Application.ActivePrinter = "Microsoft Office Document Image Writer on Ne00:"

ActiveSheet.PrintOut Copies:=1, PrintToFile:=True, Collate _
:=True, PrToFileName:="server007\BConstruct\Estimating\Shared\Andy Elliott, Backups\02.Tenders\2005 Tenders" & Left(ActiveWorkbook.Name, 4) & " " & [L1] & " " & [M1]

Cheers,

Andy

 

[SkipVought]

It's probably gonn alook like this...

Application.ActivePrinter = "Microsoft Office Document Image Writer on Ne00:"
         
   ActiveSheet.PrintOut Copies:=1, PrintToFile:=True, Collate _
        :=True, PrToFileName:="[b][red]\\[/red]server007\BConstruct\Estimating\Shared\Andy Elliott, Backups\02.Tenders\2005 Tenders" & Left(ActiveWorkbook.Name, 4) & " " & [L1] & " " & [M1][/b]

Skip,

_{[red]Be advised:[/red]We know Newton's 3 Laws. But did you hear about the [red]FOURTH???[/red]
Only ONE fig per cookie!}

 

[xlbo]

random coincidence but I grew up in Sale (next to Altrincham) and know lots of people that went to Altrincham Grammar School !!

Rgds, Geoff

Three things are certain. Death, taxes and lost data. DPlank is to blame

Please read FAQ222-2244 before you ask a question

 

[APElliott]

Thankyou Skip!!!!!

Andy

Small World Geoff - nice place is Sale!