Building a workbook from VBA XL2003 to XL2007

[JazzSP8]

Hi All

I walked into an unexpected Office upgrade this morning at work... Yesterday I was using 2003 and today I'm using 2007...

So, now I've got all the fun of working out what does work and what doesn't, some things I've solved already but I've just come across a problem that I don't really know what to do.

I've got a Report Generator that pulls in information from various places and then spits them out again in a pretty workbook, the problem is now that the workbook isn't so pretty anymore

For some reason the formatting becomes screwy, rows / column widths get messed with, pictures get squashed and stretched.

The template for the reports are held within the master workbook, once the information is in place I create a new workbook and then export the sheets into the new one, copy and paste as values and delete the information that isn't needed anymore; here's the code that does it, I've not included the full macro as it's quite lengthy and seems to be working OK...

'Names the file according to the construction formula found in Cell A6 on the 'Data' worksheet
'Environ("Username") used to make the sheet dynamic so reports can be run on any machine!
filename = "C:\Documents and Settings\Desktop\" & Worksheets("Data").Range("A6") & ".xls"
'Gives the Email a subject based on the cell A15 on the "Data" sheet.
subject = Worksheets("Data").Range("A15")
'Gives the report a proper date
DateOfReport = Worksheets("Data").Range("A20")
'Pickup the Signature
Signature = Worksheets("Daily Sales Report Generator").Range("K13")

DoEmail = Worksheets("Data").Range("A38")

'Create The Daily Sales Entered Report Workbook
Application.StatusBar = "Creating Daily Sales Entered Report"
Workbooks.Add
Worksheets.Add
Sheets("Sheet1").Name = "Call Handling Report"
Sheets("Sheet2").Name = "Daily Sales Report"

'These sheets need to be added because of the INDIRECT formulas used when building the
'AHT Reports
Worksheets.Add
Sheets("Sheet3").Name = "AHT - Red Team"
Worksheets.Add
Sheets("Sheet4").Name = "AHT - Gold Team"
Worksheets.Add
Sheets("Sheet5").Name = "AHT - Silver Team"
Worksheets.Add
Sheets("Sheet6").Name = "AHT - Others"

'Copy all AHT Data into the new Workbook.  Once Pasted, copy again and paste as
'values to lock them into the spreadsheet, otherwise the INDIRECT formulas create #REF errors.
Workbooks("Super Daily Sales Entered Report Generator - NEW AGENTS.xls").Sheets("AHT - Red Team").Cells.Copy
Sheets("AHT - Red Team").Paste
Application.CutCopyMode = False
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        
Workbooks("Super Daily Sales Entered Report Generator - NEW AGENTS.xls").Sheets("AHT - Gold Team").Cells.Copy
Sheets("AHT - Gold Team").Paste
Application.CutCopyMode = False
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues

Workbooks("Super Daily Sales Entered Report Generator - NEW AGENTS.xls").Sheets("AHT - Silver Team").Cells.Copy
Sheets("AHT - Silver Team").Paste
Application.CutCopyMode = False
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        
Workbooks("Super Daily Sales Entered Report Generator - NEW AGENTS.xls").Sheets("AHT - Others").Cells.Copy
Sheets("AHT - Others").Paste
Application.CutCopyMode = False
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues

' Copy Sales Report and Call handling sheet over.
Workbooks("Super Daily Sales Entered Report Generator - NEW AGENTS.xls").Sheets("CPC Daily Sales Report").Cells.Copy
Sheets("Daily Sales Report").Paste
Application.CutCopyMode = False
        
        Sheets("Daily Sales Report").Select
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        
Workbooks("Super Daily Sales Entered Report Generator - NEW AGENTS.xls").Sheets("CPC AHT").Cells.Copy
Sheets("Call Handling Report").Paste
Application.CutCopyMode = False
        
        Sheets("Call Handling Report").Select
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        
' Switch off alerts so that no warnings appear when sheets are being deleted.
Application.DisplayAlerts = False

' Delete the AHT Reports from the new report, which are not needed now.
With ActiveWorkbook
    Sheets("AHT - Others").Delete
    Sheets("AHT - Gold Team").Delete
    Sheets("AHT - Silver Team").Delete
    Sheets("AHT - Red Team").Delete
    End With
    
' Switch the alerts back on
Application.DisplayAlerts = True
    
' Just to pretty things up, remove the Gridlines, Column / Row headers for the main sheet
    
Sheets("Daily Sales Report").Select
With ActiveWindow
    .DisplayGridlines = False
    .DisplayHeadings = False
    End With
    
' This section was "borrowed" from the Internet and is designed to change the Graph
' series so that it is no longer linked to the Report Generator.
'
' It has the same function of selecting the graph range, clicking into the Formula bar
' and pressing F9
'
' The original code can be found at http://peltiertech.com/Excel/Charts/chartmisc.html#DelinkCht

For Each objCht In ActiveSheet.ChartObjects
         ''' Loop through all series in active chart
        For Each ChtSeries In objCht.Chart.SeriesCollection
            nPts = ChtSeries.Points.Count
            xArray = ""
            yArray = ""
            xVals = ChtSeries.XValues
            yVals = ChtSeries.Values
            sSrsName = ChtSeries.Name
            iPlotOrder = ChtSeries.PlotOrder
             
            For iPts = 1 To nPts
                If IsNumeric(xVals(iPts)) Then
                     ''' shorten numbers in X array (remove excess digits)
                    iChars = WorksheetFunction.Max _
                    (InStr(CStr(xVals(iPts)), "."), 5)
                    xArray = xArray & Left(CStr(xVals(iPts)), iChars) & ","
                Else
                     ''' put quotes around string values
                    xArray = xArray & """" & xVals(iPts) & ""","
                End If
                 
                 ''' shorten numbers in Y array (remove excess digits)
                iChars = WorksheetFunction.Max _
                (InStr(CStr(yVals(iPts)), "."), 5)
                 
                 ''' handle missing data - replace blanks and #N/A with #N/A
                If IsEmpty(yVals(iPts)) Or WorksheetFunction.IsNA(yVals(iPts)) Then
                    yArray = yArray & "#N/A,"
                Else
                    yArray = yArray & Left(CStr(yVals(iPts)), iChars) & ","
                End If
                 
            Next
             
             ''' remove final comma
            xArray = Left(xArray, Len(xArray) - 1)
            yArray = Left(yArray, Len(yArray) - 1)
             
             ''' Construct the new series formula
            ChtSeries.Formula = "=SERIES(""" & sSrsName & """,{" & xArray & "},{" _
            & yArray & "}," & CStr(iPlotOrder) & ")"
        Next
    Next
'
' End of borrowed code.
'

' Just to pretty things up, remove the Gridlines, Column / Row headers for the AHT Sheet

Sheets("Call Handling Report").Select
With ActiveWindow
    .DisplayGridlines = False
    .DisplayHeadings = False
    .Zoom = 75
    End With
    
'Borrowed code, see above.  Removes all links from Graph series.

For Each objCht In ActiveSheet.ChartObjects
         ''' Loop through all series in active chart
        For Each ChtSeries In objCht.Chart.SeriesCollection
            nPts = ChtSeries.Points.Count
            xArray = ""
            yArray = ""
            xVals = ChtSeries.XValues
            yVals = ChtSeries.Values
            sSrsName = ChtSeries.Name
            iPlotOrder = ChtSeries.PlotOrder
             
            For iPts = 1 To nPts
                If IsNumeric(xVals(iPts)) Then
                     ''' shorten numbers in X array (remove excess digits)
                    iChars = WorksheetFunction.Max _
                    (InStr(CStr(xVals(iPts)), "."), 5)
                    xArray = xArray & Left(CStr(xVals(iPts)), iChars) & ","
                Else
                     ''' put quotes around string values
                    xArray = xArray & """" & xVals(iPts) & ""","
                End If
                 
                 ''' shorten numbers in Y array (remove excess digits)
                iChars = WorksheetFunction.Max _
                (InStr(CStr(yVals(iPts)), "."), 5)
                 
                 ''' handle missing data - replace blanks and #N/A with #N/A
                If IsEmpty(yVals(iPts)) Or WorksheetFunction.IsNA(yVals(iPts)) Then
                    yArray = yArray & "#N/A,"
                Else
                    yArray = yArray & Left(CStr(yVals(iPts)), iChars) & ","
                End If
                 
            Next
             
             ''' remove final comma
            xArray = Left(xArray, Len(xArray) - 1)
            yArray = Left(yArray, Len(yArray) - 1)
             
             ''' Construct the new series formula
            ChtSeries.Formula = "=SERIES(""" & sSrsName & """,{" & xArray & "},{" _
            & yArray & "}," & CStr(iPlotOrder) & ")"
        Next
    Next
'
' End of borrowed code.
'

' Sort out the Print Area

Sheets("Daily Sales Report").Select

Range("A1:T43").Select
    ActiveSheet.PageSetup.PrintArea = "$A$1:$T$43"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.393700787401575)
        .FooterMargin = Application.InchesToPoints(0.393700787401575)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

Sheets("Call Handling Report").Select

Range("A1:T43").Select
    ActiveSheet.PageSetup.PrintArea = "$A$1:$AG$72"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.393700787401575)
        .FooterMargin = Application.InchesToPoints(0.393700787401575)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    
' Make sure the right sheet is selected when saved
Sheets("Daily Sales Report").Select

' Switch Calculation back on so workbook doesn't reset to manual.
Application.CalculateBeforeSave = True
ActiveWorkbook.SaveAs filename

' Double save, fixes problem with saving sometimes encountered.
ActiveWorkbook.Close savechanges:=False
Application.CalculateBeforeSave = True

The only clue that I have as to why something is wrong is that when I try to open the created workbook I get the message.

"The file that you are trying to open, 'NAME OF REPORT.xls', is in a different format than specified by the file extension. Verify that the file is not corrupted and is from a trusted source before opening the file. Do you want to open the file now?"

(NAME OF REPORT is the name of the report, it changes based on the output and isn't an error )

I did think that it might be something to do with the way I create the file;

filename = "C:\Documents and Settings\pspeight\Desktop\" & Worksheets("Data").Range("A6") & ".xls"

But I'm a bit out of my depth and in a mild panic...

Anyone see anything obvious that I can't see or suggest something to try?

Thanks in advance...

 

[Andrew Poulsom]

Maybe this will help you:

http://www.rondebruin.nl/saveas.htm

 

[JazzSP8]

Hi Andrew

Thanks for the link

It stopped the error message from appearing but it's not done anything to help with the formatting of the page.

I'll have a look at the way the data gets copied and pasted next, I think that's a way to go

 

[JazzSP8]

Still having no luck with this one, the formatting keeps going screwy no matter what, I thought it would be simple enough to re-record the copy and paste into the new workbook which gave me;

Selection.PasteSpecial Paste:=xlPasteValues
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False

But still looks the same, even though when I recorded those steps it worked fine

 

[Andrew Poulsom]

Maybe this line is the problem:

        Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False

That's new in Excel 2007.

 

[JazzSP8]

Suspected that myself Andrew but it's the only way I can preserve the formatting, at least manually and I don't know of any other ways.

My other trouble is that they've not updated everyone to 2007, apparantly there doing it piece by piece and not at any kind of pace, there doing 10 more people on Thursday and not sure when they'll do others...

S'all a bit of a joke really.

For now I guess I'm stuck manually doing this bit every morning, I'll have to see research it more when I've got the time, perhaps even a good excuse to rebuild it all from scratch, the code is three years old now and quite cringeworthy to look at now compared to the things I've learnt since.

... Either that or wait till they've updated everyone to 2007 and then go from there with an entirely new soloution

Thanks for taking the time to look all the same.

 

[Andrew Poulsom]

In Excel 2003 it's:

    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False