Solved

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

Posted on 2012-04-05
6
388 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 119

Expert Comment

by:Rey Obrero
Comment Utility
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
Comment Utility
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 119

Expert Comment

by:Rey Obrero
Comment Utility
post the WHOLE codes
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:colinasad
Comment Utility
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 33

Accepted Solution

by:
Norie earned 500 total points
Comment Utility
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
Comment Utility
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

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

762 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now