Results 1 to 3 of 3
  1. #1
    Join Date
    Oct 2005
    Posts
    183

    Unanswered: Exporting to excel, going nuts

    I've got a procedure running in a small app I made - with a little help from the guys here - , that exports data to excel and does some simple formatting. I figured I'd reuse it - being the downright lazy b I am - on another process, so I adopted the stuff to fit the new recordset and it almost works.

    BUT, I just can't figure out what is wrong.

    The data gets exported right, but the functions formatting the spreadsheet just don't work. Well, I don't get any errors at all, and the debugger passes the code as well, but nothing happens in the excel sheet.

    Code:
    Private Sub knap_exportIPD_Click()
        On Error GoTo errorhandler
    
    ' Procedure udviklet for Gramex af Kenny Traving, 2005
    
        Dim Sikker As Integer
        Dim filnavn As String
        Dim objXL As Object
        Dim objActiveWkb As Object
        Dim db As DAO.Database
        Dim rs As DAO.Recordset
        Dim rekke As Integer
        Dim rekkeantal As Integer
        Dim cnt As Integer
        Dim temptxt As String
        Dim temptxt2 As String
        Dim tempnum As Double
        Dim klonner As Integer
        Dim i As Integer
        Dim dytval As Integer 'bruges udelukkende til returværdier og skrald
        
        filnavn = "Integram Members Match mod Gramex via IPDnr 2005.xls"
        
        Sikker = MsgBox("Er du sikker på du vil eksportere til Excel? Eksport funktionne tager lidt tid", vbYesNo)
    
        If Sikker = 6 Then
        
            DoCmd.Hourglass True
            
            rekke = 2 'This is a counter for calculations
            
            Set objXL = CreateObject("Excel.Application")
            objXL.Visible = False
            objXL.Application.Workbooks.Add
            Set objActiveWkb = objXL.Application.ActiveWorkbook
            
            Set db = CurrentDb
            Set rs = db.OpenRecordset("(06) - Afsluttende oversigt", dbReadOnly)
            
            klonner = rs.Fields.Count
                    
            For i = 1 To klonner
                With objActiveWkb
                    .Worksheets(1).Cells(1, i) = rs.Fields(i - 1).Name
                    .Worksheets(1).Cells(1, i).Interior.ColorIndex = 15
                    .Worksheets(1).Cells(1, i).Interior.Pattern = xlSolid
                End With
            Next i
            
            With objActiveWkb
                .Application.DisplayAlerts = False
                .Worksheets(2).Delete
                .Worksheets(2).Delete
                .Application.DisplayAlerts = True
            End With
            
            rekkeantal = rs.RecordCount
            dytval = SysCmd(acSysCmdInitMeter, "Overfører poster til Excel", rekkeantal)
            
            
            While rs.EOF <> True
            
                i = 0
                
                For i = 1 To klonner
                    objActiveWkb.Worksheets(1).Cells(rekke, i) = rs.Fields(i - 1).Value
                Next i
       
                rekke = rekke + 1
                dytval = SysCmd(acSysCmdUpdateMeter, rekke)
     
                rs.MoveNext
            Wend
    
        Dim hvilkenrow As String
        
        dytval = SysCmd(acSysCmdRemoveMeter)
        
        i = 0
     
        objActiveWkb.Cells.Select
        rekke = rs.RecordCount
        Set detteark = Selection
        
        dytval = SysCmd(acSysCmdInitMeter, "Formatterer Excel-ark", rekkeantal)
        
        For i = 1 To rekke
        
            If detteark.Cells(i, 19) = "SAND" Then
                If (i / 2) = 1 Then
                    MsgBox "Test er: " & detteark.Cells(i, 19) & " slut test", vbOKOnly
                End If
                hvilkenrow = "H" & Trim(Str(i)) & ":O" & Trim(Str(i)) & ""
                Range(hvilkenrow).Select
                With Selection.Interior
                    .ColorIndex = 6
                    .Pattern = xlSolid
                End With
            End If
            
            dytval = SysCmd(acSysCmdUpdateMeter, rekke)
            
        Next i
     
        dytval = SysCmd(acSysCmdRemoveMeter)
        
        objXL.Visible = True
        
        objXL.SetFocus
        
        objActiveWkb.Cells.Select
            
        Selection.columns.AutoFit
        
        Range("A2").Select
        ActiveWindow.FreezePanes = True
        
        DoCmd.Hourglass False
    
        Else
            MsgBox "Du har valgt at afbryde eksporten", vbInformation
            Exit Sub
        End If
    
    errorhandler:
        objXL.Visible = True
        DoCmd.Hourglass False
    
    End Sub
    I've tried playing around a bit using setfoucs and doing other types of formatting, bud diddly happens So I'd appreciate any suggestions with a million - kisses for ladies only.

    Cheers, Trin
    IT squid: networks, servers, firewalls, routers and I dabble a little with SQL-server and Access as well....

  2. #2
    Join Date
    Oct 2005
    Posts
    183
    Problem solved... bad object reference... should be

    objActiveWkb.Worksheets(1).Cells.Select

    I was missing the worksheet reference.

    Thanks anyhoot.

    Cheers, Flix
    IT squid: networks, servers, firewalls, routers and I dabble a little with SQL-server and Access as well....

  3. #3
    Join Date
    Apr 2004
    Location
    outside the rim
    Posts
    1,011
    I don't get any errors at all, and the debugger passes the code as well, but nothing happens in the excel sheet.
    The downside of automation - the error messages don't get fed back (at least not with Excel).

    The best way to debug code written to automate Excel is to put it back in Excel and run it there.
    have fun!

    Todd S.
    click to email


    Independent Development Consultant
    Biz db & reports - SQL, Access, Crystal, Seradex and more
    Small, custom, unique programs - Office, VBA, .NET


    _________________________________________________
    Favorite message from Windows:
    There was an error displaying the previous error message

    Sadly, there was no error number to look up ...

Posting Permissions

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