Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Why do I get this VBA error message when creating an Excel spreadsheet in Access?

Posted on 2012-04-05
6
Medium Priority
?
419 Views
Last Modified: 2012-04-05
I am developing an Access 2007 "project" (.adp) as a front-end to data stored in a SQL Server 2005 Express database.

One task I allow the operator to do in the Access application is to create an Excel spreadsheet for carrying out a stock count in a shop.

Using VBA code behind the scenes, I declare the following variables :

    Dim rsTarget As New ADODB.Recordset
   
    Dim oApp As New Excel.Application
    Dim oBook As Excel.Workbook
    Dim oSheet As Excel.Worksheet

I populate rsTarget with a SQL query and then

    Set oBook = oApp.Workbooks.Add
    Set oSheet = oBook.Worksheets(1)

In a "With oSheet" block of coding I copy the data from the recordset into the spreadsheet using

            .Range("A7").CopyFromRecordset rsTarget

I can also do various cell formatting tasks and evrything seems to work OK.

However, I am getting an error message when I try to merge a few cells so that the shop name will be visible across a few columns.
I have carried out this task in a spreadsheet while recording a macro so that I can see the instructions that are being carried out. These appear to be as below :

                    Range("C1:G1").Select
                    With Selection
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = False
                    End With
                    Selection.Merge
                    With Selection
                        .HorizontalAlignment = xlLeft
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = True
                    End With

When I plug these into my VBA code, it compiles OK but I get the run-time error message :

Method 'Range' of object '_Global' failed

Can anyone explain why this happens and what I need to do to avoid it?

Many thanks.
0
Comment
Question by:colinasad
  • 3
  • 2
6 Comments
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 37810505
you need to reference the range() from the active sheet, like what you did with the  copyfromrecordset

with oSheet
  .Range("C1:G1").Select
0
 

Author Comment

by:colinasad
ID: 37810611
Thanks for the prompt response, capricorn1.

I am doing my "Range("C1:G1").Select" line inside a "With oSheet" block, but had omitted the leading "." character.
".Range("C1:G1").Select"
seems to avoid the error message I was getting.

However I am now getting the run-time error :

"Object variable or With block variable not set"

This is happening just inside the "With Selection ..." block of code immediately following the ".Range("C1:G1").Select" line.
Is there a prefix I should be adding to the "Selection" expression?
".Selection" causes a VBA compilation error.
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 37810684
post the WHOLE codes
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:colinasad
ID: 37810728
Thanks, capricorn1.

Here is my "spreadheet producing" VBA procedure in its entirity.
Hopefully you can filter the relevant "Excel" handling commands from the data handling instructions.
The procedure is peppered with an "intPosn" variable that I use in the "HandleError" message allowing me to pin-point precisely where the code breaks down.
The most recent error is happening at intPosn = 1921.


Public Sub CreateShopMerchExcel(strShopCode As String)
    ' Try and populate a spreadsheet with data for Merchandising a shop
    ' This approach results in Excel being launched with the filled spreadsheet offered to the user
    ' The user can then save the spreadsheet as they wish
   
    ' Complicated bit is listing the quantity delivered in an unknown number of deliveries
    ' since the last Stock Count.
    ' These "events" have already been saved in TBL_TempShopMerchEvents
    ' We allow for 3 of these deliveries since the previous stock count

On Error GoTo HandleError
    Dim intPosn As Integer
   
intPosn = 100
   
    Dim strSQLCommand As String
   
    Dim blnProceed As Boolean
   
    Dim lngLines As Long
    Dim intColumns As Integer
   
    Dim intCounter As Integer
   
    Dim strShopName As String
    Dim datPrevCountDate As Date
   
    Dim intMaxRecentDelvs As Integer
    Dim intNumRecentDelvs As Integer
    Dim strDelvRef1 As String
    Dim strDelvRef2 As String
    Dim strDelvRef3 As String
    Dim datDelvDate1 As Date
    Dim datDelvDate2 As Date
    Dim datDelvDate3 As Date
   
   
    Dim rsTarget As New ADODB.Recordset
   
    Dim oApp As New Excel.Application
    Dim oBook As Excel.Workbook
    Dim oSheet As Excel.Worksheet

intPosn = 110
   
    intMaxRecentDelvs = 3
    intNumRecentDelvs = 0
   
    strDelvRef1 = ""
    strDelvRef2 = ""
    strDelvRef3 = ""
    datDelvDate1 = "01/01/1900"
    datDelvDate2 = "01/01/1900"
    datDelvDate3 = "01/01/1900"
   
    blnProceed = True
   
    If genAllBlanks(Nz(strShopCode, "")) Then
        MsgBox "No instruction received to populate spreadsheet", , "Fill Spreadsheet"
    Else
        strShopName = ReadRecordField("String", strShopCode, "", "", _
                                            "TBL_Shops", _
                                            "Shop_Code", "", "", _
                                            "Shop_Name")
        datPrevCountDate = ReadRecordField("Date", strShopCode, "", "", _
                                            "TBL_Shops", _
                                            "Shop_Code", "", "", _
                                            "Shop_LastCountDate")
                               
intPosn = 112
        ' strSQLCommand for reading recent delivery events
        ' Previously filled with events since the Shops previous Stock Count Date
       
        strSQLCommand = "SELECT * " & _
                    "FROM TBL_TempShopMerchEvents " & _
                    "WHERE ShpMerchEvent_ShopCode = '" & strShopCode & "' " & _
                    "ORDER BY ShpMerchEvent_Date"

        ' Fill the Recordset based on the SQL Command
        Set rsTarget = ReadRecordset(strSQLCommand)
intPosn = 114
           
        If Not (rsTarget.BOF And rsTarget.EOF) Then
intPosn = 116
            intNumRecentDelvs = rsTarget.RecordCount
            intColumns = rsTarget.Fields.Count
           
            If intNumRecentDelvs > intMaxRecentDelvs Then
                MsgBox "Number of recent deliveries : " & intNumRecentDelvs & vbCrLf & _
                        "Exceeds maximum allowed : " & intMaxRecentDelvs & vbCrLf & _
                        "Cannot Proceed", , "Shop Stock Count Sheet Export"
               
                blnProceed = False
            End If
           
            If intNumRecentDelvs > 0 Then
                rsTarget.MoveFirst
               
                For intCounter = 1 To intNumRecentDelvs
                    Select Case intCounter
                        Case 1
                            strDelvRef1 = Nz(rsTarget.Fields("ShpMerchEvent_Reference"), "")
                            datDelvDate1 = Nz(rsTarget.Fields("ShpMerchEvent_Date"), "01/01/1900")
                        Case 2
                            strDelvRef2 = Nz(rsTarget.Fields("ShpMerchEvent_Reference"), "")
                            datDelvDate2 = Nz(rsTarget.Fields("ShpMerchEvent_Date"), "01/01/1900")
                        Case 3
                            strDelvRef3 = Nz(rsTarget.Fields("ShpMerchEvent_Reference"), "")
                            datDelvDate3 = Nz(rsTarget.Fields("ShpMerchEvent_Date"), "01/01/1900")
                    End Select
                   
                    rsTarget.MoveNext
                Next intCounter
            End If
        End If
           
        ' Close and Clear the recordset from memory
        rsTarget.Close
        Set rsTarget = Nothing
       
        MsgBox "Have checked for recent deliveries." & vbCrLf & _
                "Max deliveries allowed : " & intMaxRecentDelvs & vbCrLf & _
                "Number of deliveries found : " & intNumRecentDelvs & vbCrLf & _
                "Delv Date 1 : " & datDelvDate1 & "   Delv Ref 1 : " & strDelvRef1 & vbCrLf & _
                "Delv Date 2 : " & datDelvDate2 & "   Delv Ref 2 : " & strDelvRef2 & vbCrLf & _
                "Delv Date 3 : " & datDelvDate3 & "   Delv Ref 3 : " & strDelvRef3, , _
                "Shop Stock Count Sheet Export"
       
        If blnProceed Then
            ' Re-use the recordset for spreadsheet data
           
            lngLines = 0
            intColumns = 0
           
            ' strSQLCommand for reading required data into a recordset
            strSQLCommand = "SELECT ShpMerchStock_APTightCode, ShpMerchStock_Category, " & _
                        "ShpMerchStock_StockCode, '' AS 'THISCOUNT', " & _
                        "CONVERT (varchar(20), ShpMerchStock_LastCountDate, 103) AS 'LASTCOUNTDATE', " & _
                        "ShpMerchStock_LastCountQnt, " & _
                        "ShpMerchStock_DeliveredSince, " & _
                        "ShpMerchStock_LastCountQnt + ShpMerchStock_DeliveredSince AS 'AVAIL', " & _
                        "'', " & _
                        "ISNULL (DLV1.ShpStkHst_Qnty, '') AS 'DLV1QNT', " & _
                        "ISNULL (DLV2.ShpStkHst_Qnty, '') AS 'DLV2QNT', " & _
                        "ISNULL (DLV3.ShpStkHst_Qnty, '') AS 'DLV3QNT' " & _
                        "FROM TBL_TempShopMerchStockCodes " & _
                        "LEFT OUTER JOIN TBL_ShopStockHistory AS DLV1 " & _
                        "ON DLV1.ShpStkHst_ShopCode = '" & strShopCode & "' AND DLV1.ShpStkHst_Ref = '" & strDelvRef1 & "' " & _
                        "AND DLV1.ShpStkHst_StockCode = ShpMerchStock_StockCode " & _
                        "LEFT OUTER JOIN TBL_ShopStockHistory AS DLV2 " & _
                        "ON DLV2.ShpStkHst_ShopCode = '" & strShopCode & "' AND DLV2.ShpStkHst_Ref = '" & strDelvRef2 & "' " & _
                        "AND DLV2.ShpStkHst_StockCode = ShpMerchStock_StockCode " & _
                        "LEFT OUTER JOIN TBL_ShopStockHistory AS DLV3 " & _
                        "ON DLV3.ShpStkHst_ShopCode = '" & strShopCode & "' AND DLV3.ShpStkHst_Ref = '" & strDelvRef3 & "' " & _
                        "AND DLV3.ShpStkHst_StockCode = ShpMerchStock_StockCode " & _
                        "WHERE ShpMerchStock_ShopCode = '" & strShopCode & "' " & _
                        "ORDER BY ShpMerchStock_StockCode"
    intPosn = 125
            ' MsgBox "strSQLCommand : Length : " & Len(strSQLCommand) & vbCrLf & strSQLCommand, , "Export Spreadsheet"
           
            ' Fill the Recordset based on the SQL Command
            Set rsTarget = ReadRecordset(strSQLCommand)
    intPosn = 130
               
            ' Proceed only if the Recordset contains some rows
            If Not (rsTarget.BOF And rsTarget.EOF) Then
    intPosn = 140
                lngLines = rsTarget.RecordCount
                intColumns = rsTarget.Fields.Count
               
                ' Tell the user how many columns and rows of data the spreadsheet will contain
                MsgBox "Processing RecordSet with :" & vbCrLf & _
                            intColumns & "  Columns" & vbCrLf & _
                            lngLines & "  Lines", , "Fill Spreadsheet"
                           
                ' Prepare an Excel Workbook and Sheet
                Set oBook = oApp.Workbooks.Add
                Set oSheet = oBook.Worksheets(1)
    intPosn = 150
               
                With oSheet
                    ' First 3 rows are Shop Code, Printed Date, Count Date
                    ' Row 1 is the Shop Code - All text
                    .Cells(1, 1).VALUE = "Shop Code"
                    .Cells(1, 2).VALUE = strShopCode
                    .Cells(1, 3).VALUE = strShopName
                   
                    ' Row 2 is the printout date and Previous Shop Count Date
                    .Cells(2, 1).VALUE = "Issue Date"
                    .Cells(2, 2).VALUE = Date
                    .Cells(2, 5).VALUE = "Last Count"
                    .Cells(2, 6).VALUE = datPrevCountDate
                   
                    ' Row 3 is the count date - will be filled later by the Merchandiser
                    .Cells(3, 1).VALUE = "Count Date"
                   
                    ' Row 4 is left blank
                   
                    ' Row 5 is the first row of column headers
                    .Cells(5, 1).VALUE = "AP"
                    .Cells(5, 2).VALUE = ""
                    .Cells(5, 3).VALUE = "Joe Cool"
                    .Cells(5, 4).VALUE = "NEW"
                    .Cells(5, 5).VALUE = "Previous"
                    .Cells(5, 6).VALUE = "Previous"
                    .Cells(5, 7).VALUE = "Delivered"
                    .Cells(5, 8).VALUE = "Available"
                   
                    .Cells(5, 10).VALUE = datDelvDate1
                    .Cells(5, 11).VALUE = datDelvDate2
                    .Cells(5, 12).VALUE = datDelvDate3
                   
                    ' Row 6 is the second row of column headers
                    .Cells(6, 1).VALUE = "Code"
                    .Cells(6, 2).VALUE = "Category"
                    .Cells(6, 3).VALUE = "Code"
                    .Cells(6, 4).VALUE = "COUNT"
                    .Cells(6, 5).VALUE = "Count Date"
                    .Cells(6, 6).VALUE = "Count Qnty"
                    .Cells(6, 7).VALUE = "Since"
                    .Cells(6, 8).VALUE = "Since"
               
                    .Cells(6, 10).VALUE = strDelvRef1
                    .Cells(6, 11).VALUE = strDelvRef2
                    .Cells(6, 12).VALUE = strDelvRef3
                   
                   
                End With
    intPosn = 160
               
                ' Make all the Header Rows Bold & Text Format
                With oSheet.Rows("1:6")
    intPosn = 161
                    .NumberFormat = "@"
    intPosn = 162
                    .Font.Bold = True
    intPosn = 170
                End With
               
                With oSheet
                    ' Apart from date cells
                    .Cells(2, 2).NumberFormat = "dd/mm/yyy;@"  ' Report Date
                    .Cells(2, 6).NumberFormat = "dd/mm/yyy;@"  ' Shop Last Count Date
                    .Cells(3, 2).NumberFormat = "dd/mm/yyy;@"  ' New Count Date
                   
                    ' And the last Delivery Dates
                    .Cells(5, 10).NumberFormat = "dd/mm/yyy;@" ' Recent Delivery 1 Date
                    .Cells(5, 11).NumberFormat = "dd/mm/yyy;@" ' Recent Delivery 2 Date
                    .Cells(5, 12).NumberFormat = "dd/mm/yyy;@" ' Recent Delivery 3 Date
                   
                    'Add all the data from the Recordset, starting at cell A7
                    .Range("A7").CopyFromRecordset rsTarget
intPosn = 180
           
                    ' Make the Text columns left-justified
                    .Columns("A:C").HorizontalAlignment = xlLeft
intPosn = 185
                    ' Make the Qnty columns right-justified
                    .Columns("D:L").HorizontalAlignment = xlRight
                       
intPosn = 190
                 
                    ' Merge cells containing shop name
                    .Range("C1:G1").Select
intPosn = 192
                    With Selection
 intPosn = 1921
                        .HorizontalAlignment = xlCenter
 intPosn = 1922
                        .VerticalAlignment = xlBottom
 intPosn = 1923
                        .WrapText = False
 intPosn = 1924
                        .Orientation = 0
 intPosn = 1925
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = False
                    End With
    intPosn = 194
                    Selection.Merge
    intPosn = 196
                    With Selection
                      .HorizontalAlignment = xlLeft
                      .VerticalAlignment = xlBottom
                      .WrapText = False
                      .Orientation = 0
                      .AddIndent = False
                      .IndentLevel = 0
                      .ShrinkToFit = False
                      .ReadingOrder = xlContext
                      .MergeCells = True
                  End With
intPosn = 198
       
                   
                    'Autofit the columns
                    .Columns("A:L").EntireColumn.AutoFit
       
    intPosn = 200
                    ' Position cursor in cell A1 - ready for the operator
                    .Range("A1").Select
    intPosn = 210
                End With
               
                ' Pass control of the spreadsheet over to the operator
                oApp.Visible = True
                oApp.UserControl = True
    intPosn = 220
       
            Else
                MsgBox "No data has been found to transfer to a spreadsheet", , "Spreadsheet Create"
            End If
           
            ' Close and Clear the recordset from memory
            rsTarget.Close
            Set rsTarget = Nothing
        End If
    End If
   
    Exit Sub
   
HandleError:
    genErrorHandler Err.Number, Err.DESCRIPTION, "DB_LOGIC", "CreateShopMerchExcel Pos " & intPosn
   
    Exit Sub
End Sub ' CreateShopMerchExcel
0
 
LVL 35

Accepted Solution

by:
Norie earned 2000 total points
ID: 37811480
Instead of using Selection in the With use the actual range
                   intPosn = 192
                    With  .Range("C1:G1")
 intPosn = 1921
                        .HorizontalAlignment = xlCenter
 intPosn = 1922
                        .VerticalAlignment = xlBottom
 intPosn = 1923
                        .WrapText = False
 intPosn = 1924
                        .Orientation = 0
 intPosn = 1925
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = False
                    End With
    intPosn = 194
                    . .Range("C1:G1").Merge
    intPosn = 196
                    With  .Range("C1:G1").
                      .HorizontalAlignment = xlLeft
                      .VerticalAlignment = xlBottom
                      .WrapText = False
                      .Orientation = 0
                      .AddIndent = False
                      .IndentLevel = 0
                      .ShrinkToFit = False
                      .ReadingOrder = xlContext
                      .MergeCells = True
                  End With

Open in new window

By the way, you don't need to merge to display the data across columns, you can use the alignment Center across selection.

    With  .Range("C1:G1")
            .HorizontalAlignment = xlCenterAcrossSelection    
    End With

Open in new window

0
 

Author Closing Comment

by:colinasad
ID: 37811595
Many thanks, imnorie.
Your first suggestion did the job and your second suggestion looks much more elegant.
I hope to do some other spreadsheet "design" tasks with my VBA code (such as making one column the sum of the values in the previous 3 columns) so this solution might help me there too.
Regards.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Access has a limit of 255 columns in a single table; SQL Server allows tables with over 255 columns, but reading that data is not necessarily simple.  The final solution for this task involved creating a custom text parser and then reading…
In a use case, a user needs to close an opened report by simply pressing the Escape (Esc) key. This can be done by adding macro code in Report_KeyPress or Report_KeyDown event.
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…

885 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question