CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 11 of 11
  1. #1
    Join Date
    May 2005
    Location
    Sterling Heights, MI
    Posts
    74

    Application-defined or object defined error in Excel VBA from VB6

    I am getting an "Runtime error 1004 Application-defined or object defined error" on the highlighted line when I run this sub
    Code:
    Private Sub PrintIssues()
    Dim i As Long
    
    	Set objExcel = New Excel.Application
    	Set bkWorkBook = objExcel.Workbooks.Add
    	Set shWorkSheet = bkWorkBook.ActiveSheet
    	  If optAppeal.Value = True Then
    		shWorkSheet.Range("A1") = "Appeals Issues Log"
    	  Else
    		shWorkSheet.Range("A1") = "Reopens Issues Log"
    	  End If
    		shWorkSheet.Range("B3") = "Prov. Name:  " & strProvName
    		shWorkSheet.Range("A4") = "Prov. Number:  " & strProvCode
    	   ' shWorkSheet.Range("C3") = "FYE:  " & cboFYE.Text
    	  If optAppeal.Value = True Then
    		shWorkSheet.Range("A5") = "Appeal"
    	  Else
    		shWorkSheet.Range("A5") = "Reopen"
    	  End If
    		shWorkSheet.Range("C5") = "Number " & gstrAppealNo
    		shWorkSheet.Range("A8") = "Issue No"
    		shWorkSheet.Range("B8") = "Issue"
    		shWorkSheet.Range("C8") = "Analyst"
    		shWorkSheet.Range("D8") = "Disposition"
    		shWorkSheet.Range("E8") = "Est. Impact Amount"
    		shWorkSheet.Range("F8") = "Act. Impact Amount"
    		shWorkSheet.Range("G8") = "Comments"
    
    	Set rngRowStart = shWorkSheet.Range("A10")
    		  
    		bkWorkBook.Worksheets(1).Columns(1).HorizontalAlignment = xlLeft
    		bkWorkBook.Worksheets(1).PageSetup.Orientation = xlLandscape
    		bkWorkBook.Worksheets(1).PageSetup.Zoom = False
    		'in order for these PageSetup things to work, the ZOOM property
    		'must be set to false
    		bkWorkBook.Worksheets(1).PageSetup.FitToPagesWide = 1
    		bkWorkBook.Worksheets(1).PageSetup.FitToPagesTall = 1
    		bkWorkBook.Worksheets(1).Columns("E:E").HorizontalAlignment = xlCenter
    		bkWorkBook.Worksheets(1).Columns("F:F").HorizontalAlignment = xlCenter
    			 
    			For i = 1 To lvwIssues.ListItems.Count
    				'Place each element in the coresponding column
    				rngRowStart.Offset(0, 0).Value = lvwIssues.ListItems(1).Text 'issue number
    				rngRowStart.Offset(0, 1).Value = lvwIssues.ListItems(2).Text 'issue description
    				rngRowStart.Offset(0, 2).Value = lvwIssues.ListItems(3).Text 'analyst
    				rngRowStart.Offset(0, 3).Value = lvwIssues.ListItems(4).Text 'disposition
    				rngRowStart.Offset(0, 4).Value = Format(lvwIssues.ListItems(5).Text, "###,#0") 'est impact amt
    				rngRowStart.Offset(0, 5).Value = Format(lvwIssues.ListItems(6).Text, "###,#0") 'act impact amt
    				rngRowStart.Offset(0, 6).Value = lvwIssues.ListItems(7).Text
    			Next
    					
    			'Next Row
    			Set rngRowStart = rngRowStart.Offset(1, 0)
    	   
    	   'start with first row of recordset display and wedgie down a couple
    	   lngLast = bkWorkBook.Worksheets(1).Range("A10").End(xlDown).Row + 2
    	   bkWorkBook.Worksheets(1).Cells(lngLast, 5).Value = Format(lblEstImpAmt.Caption, "###,#0") 'est impact total
    	   bkWorkBook.Worksheets(1).Cells(lngLast, 6).Value = Format(lblActImpAmt.Caption, "###,#0") 'act impact total
    
    		'make sure everything displays properly.
    		shWorkSheet.Columns("A:BZ").AutoFit
    	   
    		objExcel.Visible = True
    End Sub
    What VBA mistake am I making this time?

  2. #2
    Join Date
    Dec 2004
    Posts
    423

    Re: Application-defined or object defined error in Excel VBA from VB6

    I can't really tell where the error is, but I have had lots of errors like this. One time I remember writing a Sub to give a column based on a number and using .Range instead of .Cells.

    Hope that helps.

  3. #3
    Join Date
    Aug 2003
    Location
    Sydney, Australia
    Posts
    1,900

    Re: Application-defined or object defined error in Excel VBA from VB6

    Check your lngLast value - I got 65538 which is the last row in a sheet - is that really what you wanted ?

    (lngLast = bkWorkBook.Worksheets(1).Range("A10").End(xlDown).Row + 2)

  4. #4
    Join Date
    May 2005
    Location
    Sterling Heights, MI
    Posts
    74

    Re: Application-defined or object defined error in Excel VBA from VB6

    Quote Originally Posted by Sabin_33
    I can't really tell where the error is, but I have had lots of errors like this. One time I remember writing a Sub to give a column based on a number and using .Range instead of .Cells.

    Hope that helps.
    The line on which the error occurs is highlighted in yellow. Just scroll down a mite.

  5. #5
    Join Date
    May 2005
    Location
    Sterling Heights, MI
    Posts
    74

    Re: Application-defined or object defined error in Excel VBA from VB6

    Quote Originally Posted by George1111
    Check your lngLast value - I got 65538 which is the last row in a sheet - is that really what you wanted ?

    (lngLast = bkWorkBook.Worksheets(1).Range("A10").End(xlDown).Row + 2)
    I am using this in others Subs just fine. The spreadsheet is being populated by a recordset. Each time the query is run, a different number of records will be returned, so, I will never know how far down the data will go. I need to display, two rows beneath whatever the last row it, a total for two columns.

  6. #6
    Join Date
    Dec 2004
    Posts
    423

    Re: Application-defined or object defined error in Excel VBA from VB6

    Sorry Hack, what I meant was I don't see how the error is being generated. But I've run into that type or a lot when working with VB and Excel.

    And One time I remember writing a function to give a column based on a number and using .Range instead of .Cells.

    Code:
    Private Function GetColumn(Byval lngColumn&) as string
    	
    	Select Case lngColumn
    		Case 1
    			GetColumn = "A"
    		Case 2 
    			GetColumn = "B"
    		Case 3 
    			GetColumn = "C"
    		Case 4
    			GetColumn = "D"
    ..........
    End Function
    Code:
    	   shWorkSheet.Range(GetColumn(5) & lastrow).value = Format(lblEstImpAmt, "###,#0")

  7. #7
    Join Date
    Nov 2004
    Location
    LA. California Raiders #1 AKA: Gangsta Yoda™
    Posts
    616

    Re: Application-defined or object defined error in Excel VBA from VB6

    What is the actual value of lngLast ? Make sure you dont have blank data in the rest of the sheet going down. You can always highlight the "unused" part and delete it to be sure.

    lngLast is defined as a long?

    Also, what is the value that is in - lblEstImpAmt.Caption?
    VB/Office Guru™ (AKA: Gangsta Yoda™)
    VB Forums - Super Moderator 2001-Present

    Microsoft MVP 2006-2011

    Please use [code]your code goes in here[/code] tags when posting code.

    Senior Software Engineer MCP, BSEE, CET
    VS 2012 Premium, VS 6.0 Enterprise SP6, VSTO, Office Ultimate 2010, Windows 7 Ultimate
    Star Wars Gangsta Rap SE Reputations & Rating Posts Office Primary Interop AssembliesAdvanced VB/Office Guru™ Word SpellChecker™.NETAdvanced VB/Office Guru™ Word SpellChecker™ VB6Outlook Global Address ListVB6/Crystal Report Ex.VB6/CR Print Setup Dialog Ex.

  8. #8
    Join Date
    May 2005
    Location
    Sterling Heights, MI
    Posts
    74

    Re: Application-defined or object defined error in Excel VBA from VB6

    Quote Originally Posted by RobDog888
    What is the actual value of lngLast ? Make sure you dont have blank data in the rest of the sheet going down. You can always highlight the "unused" part and delete it to be sure.

    lngLast is defined as a long?

    Also, what is the value that is in - lblEstImpAmt.Caption?
    lngLast could actually be an integer, but I never use integers. I always use longs.

    lblEstImpAmt is a number amount which is the result of a calculation. It will typically be in the hundreds of thousands if not millions.

    This output is a report. The only thing the user will want to do is print it. Makeing them delete unused portions of the spreadsheet is not something that would make them happy.

  9. #9
    Join Date
    Nov 2004
    Location
    Lincoln, NE
    Posts
    516

    Re: Application-defined or object defined error in Excel VBA from VB6

    The problem is this line:
    Code:
    lngLast = bkWorkBook.Worksheets(1).Range("A10").End(xlDown).Row + 2
    If the end of the worksheet is =< row 10, then .Range("A10").End will return 65536. When you add 2 to that, that puts the row out of range. You need to somehow make sure that the starting range is within the used range of the worksheet. I.e.:
    Code:
    If bkWorkBook.Worksheets(1).UsedRange.Rows > 10 Then
        lngLast = bkWorkBook.Worksheets(1).Range("A10").End(xlDown).Row + 2
    Else
        lngLast = bkWorkBook.Worksheets(1).UsedRange.Rows + 2
    End If

  10. #10
    Join Date
    Dec 2010
    Posts
    1

    Smile Re: Application-defined or object defined error in Excel VBA from VB6

    Similar problems encountered with my VBA with Application-defined or object defined error. Can someone pls. help me to correct my program? I would really appreciate your help. The program stated below is very simple & I hope anyone can immediately see what's wrong with this.


    Sub Concatenate()
    Dim BaseRow As Integer, HeaderCol As Integer
    HeaderCol = 1
    Dim BaseAdd As String



    For x = 2 To 256
    If IsEmpty(Cells(6, x)) Then
    x = 257
    End If

    If IsEmpty(Cells(6, x)) = False Then '-----> problem occurred at this line
    Cells(6, x).Select
    Selection.Copy
    Cells(10, HeaderCol).Select
    ActiveSheet.Paste
    HeaderCol = HeaderCol + 1
    End If
    Next x



    End Sub

    Waiting for any reply...Thanks

  11. #11
    Join Date
    Jan 2006
    Location
    Fox Lake, IL
    Posts
    15,007

    Re: Application-defined or object defined error in Excel VBA from VB6

    ??? This is an old post by Hack, and you revive it again as T-Hack???

    Please start a new thread.
    David

    CodeGuru Article: Bound Controls are Evil-VB6
    2013 Samples: MS CODE Samples

    CodeGuru Reviewer
    2006 Dell CSP
    2006, 2007 & 2008 MVP Visual Basic
    If your question has been answered satisfactorily, and it has been helpful, then, please, Rate this Post!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  





Click Here to Expand Forum to Full Width

Featured