Results 1 to 3 of 3
  1. #1
    Join Date
    Nov 2007
    Posts
    93

    Unanswered: excel automation

    hello freinds !!

    i am little confusion so as how to work on excel automation stuff

    here is my problem

    I have 2 tables in MS access and performing few operations in access and exporting the results from the tables of access to EXCEL using excel automation.

    my concern is :
    1. when i ouptut the result to excel sheet .. i want to perform a comparision on access tables and get a cell (in excel sheet) to be colored

    like for example :
    if the value is 12 in one of the fields say pricefield1 in table1 of access
    and the value is 13 in the pricefield1 of table2

    then in excel sheet the color for the cell shuld be changed to red

    i have no clue how to proceed from here

    any thoughts would be appreciated

    thanks,
    Sam

  2. #2
    Join Date
    May 2004
    Posts
    65

    Excel procedure export

    Create an event procedure with code like below.

    Please note this is straight out of a routine where I am adding information from an access table, so you will need to tweak to suit. It does show you how to change colours of cells and add values.

    If you wanted to change a cell based on the access value - refer to the access value like: If rs!myvalue = 3 then 'change colour box code...'

    Dim intButSelected As Integer, intButType As Integer
    Dim strmsgprompt As String, strmsgtitle As String
    Dim objXL As Object
    Dim objActiveWkb As Object
    Dim db As DAO.Database 'Might have to remove the DAO.
    Dim rs As DAO.Recordset 'Might have to remove the DAO.
    Dim Row As Integer
    Dim cnt As Integer
    Dim temptxt As String
    Dim temptxt2 As String
    Dim tempnum As Double

    Row = 3 'This is a counter for calculations so you may not need this

    Set objXL = CreateObject("Excel.Application")
    objXL.Visible = True
    objXL.Application.Workbooks.Add
    Set objActiveWkb = objXL.Application.ActiveWorkbook

    Set db = CurrentDb
    Set rs = db.OpenRecordset("Customers", dbOpenDynaset)

    With objActiveWkb
    '************ Create Worksheet Headings
    '.Worksheets(1).Cells(1, 3) = Text10
    .Worksheets(1).Cells(1, 1) = List4
    .Worksheets(1).Cells(2, 2) = "First Name"
    .Worksheets(1).Cells(2, 3) = "Last Name"
    .Worksheets(1).Cells(2, 5) = "Comment"

    '************** Deletes the 2 other sheets that excel automatically creates
    .Application.DisplayAlerts = False
    .Worksheets(3).delete
    .Worksheets(2).delete
    .Application.DisplayAlerts = True

    '************** Add customers to worksheet
    While rs.EOF <> True
    If rs!Customer_no <> 0 Then
    .Worksheets(1).Cells(Row, 1) = rs!Customer_no
    .Worksheets(1).Cells(Row, 2) = rs!FirstName
    .Worksheets(1).Cells(Row, 3) = rs!LastName
    Row = Row + 1
    End If
    rs.MoveNext
    Wend
    '****** Hide Column A – I use this because column A stores information I need later
    .Worksheets(1).Columns("A:A").Select
    .Worksheets(1).Columns("A:A").EntireColumn.Hidden = True
    .Worksheets(1).Rows("1:1").Select
    .Worksheets(1).Rows("1:1").EntireRow.Hidden = True
    '******** Set page size and fonts
    .Worksheets(1).PageSetup.Orientation = xlPortrait
    .Worksheets(1).PageSetup.PaperSize = xlPaperA4
    .Worksheets(1).PageSetup.LeftMargin = 40
    .Worksheets(1).PageSetup.RightMargin = 20
    .Worksheets(1).PageSetup.TopMargin = 60
    .Worksheets(1).PageSetup.BottomMargin = 20
    .Worksheets(1).Columns("A:G").Select
    .Worksheets(1).Columns("A:G").Font.Name = "Arial"
    .Worksheets(1).Columns("A:G").Font.Size = 12

    .Worksheets(1).Range("C1").Select
    .Worksheets(1).Range("C1").Font.Name = "Arial"
    .Worksheets(1).Range("C1").Font.Size = 14
    .Worksheets(1).Range("C1").Font.Bold = True
    .Worksheets(1).Range("B2:E2").Select
    .Worksheets(1).Range("B2:E2").Font.Bold = True

    '********* Create borders
    .Worksheets(1).Range("B2:E2").Select
    .Worksheets(1).Range("B2:E2").Borders(xlDiagonalDo wn).LineStyle = xlNone
    .Worksheets(1).Range("B2:E2").Borders(xlDiagonalUp ).LineStyle = xlNone
    With .Worksheets(1).Range("B2:E2").Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With .Worksheets(1).Range("B2:E2").Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With .Worksheets(1).Range("B2:E2").Borders(xlEdgeBottom )
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With .Worksheets(1).Range("B2:E2").Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    .Worksheets(1).Range("B2:E2").Borders(xlInsideVert ical).LineStyle = xlNone
    With .Worksheets(1).Range("B2:E2").Interior
    .ColorIndex = 36
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With

    'Put box around – Notice you can refer directly to absolute cells or change them using a row or column counter like the one declared at the beginning.
    With .Worksheets(1)
    temptxt = "B3:E" & Row - 1

    .Range(temptxt).Select
    .Range(temptxt).Borders(xlDiagonalDown).LineStyle = xlNone
    .Range(temptxt).Borders(xlDiagonalUp).LineStyle = xlNone
    With .Range(temptxt).Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    End With

    '********* Shade every second line
    cnt = 3
    While cnt <= Row - 1
    If (cnt / 2 - Int(cnt / 2)) * 10 <> 0 Then
    temptxt = "B" & cnt & ":E" & cnt
    '.Worksheets(1).Range(temptxt).Borders(xlInsideVer tical).LineStyle = xlNone
    With .Worksheets(1).Range(temptxt).Interior
    .ColorIndex = 35
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With
    End If

    cnt = cnt + 1
    Wend

    '***********Change Row Height
    With .Worksheets(1)
    .Rows("3:32").Select
    .Range("B3").Activate
    .Rows("3:" & Row).RowHeight = 23
    End With
    temptxt = "E3:E" & Row

    With .Worksheets(1).Range(temptxt)
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    With .Worksheets(1).Range(temptxt).Font
    .Name = "Arial"
    .FontStyle = "Regular"
    .Size = 10
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    '******** Change column widths
    .Worksheets(1).Columns("D").ColumnWidth = 10
    .Worksheets(1).Columns("B:B").ColumnWidth = 15
    .Worksheets(1).Columns("C:C").ColumnWidth = 25
    .Worksheets(1).Columns("E:E").ColumnWidth = 40

  3. #3
    Join Date
    Apr 2004
    Location
    outside the rim
    Posts
    1,011
    A "quick" way to start running Excel from other apps (such as Access):

    1) Open Excel
    2) Start recording a macro
    3) Do what it is you want to do (for the most part)
    4) Stop the macro recorder
    5) Open the VBA Editor in Excel and view the code behind the macro

    What you have is the code to accomplish what you recorded the macro to do. With some editing and trimming, you should be able to come up with a piece of code that does your Excel task.

    Now, in Access:

    1) Open a VB window.
    2) Under Tools, References, make sure Excel is referenced (this is important)
    3) In your Sub or Function, DIM an object as an Excel.Application*

    Now, to use the code you copied from Excel, every Excel function or object needs to be preceded with your Excel object name. A quick way to do this is to use a "With ... End With" loop and then put a dot in front of each Excel object.

    In Excel:
    Code:
    Sub Macro1()
    '
    ' Macro1 Macro
    ' Macro recorded 1/8/2008 by User
    '
    
    '
        ' Turn the back fill red, the text white and bold
        With Selection.Interior
            .ColorIndex = 3
            .Pattern = xlSolid
        End With
        Selection.Font.ColorIndex = 2
        Selection.Font.Bold = True
    End Sub
    Then, in Access:
    Code:
    Dim objExcel As New Excel.Application
    
    With objExcel
        ' Turn the back fill red, the text white and bold
        With .Selection.Interior
            .ColorIndex = 3
            .Pattern = xlSolid
        End With
        .Selection.Font.ColorIndex = 2
        .Selection.Font.Bold = True
    End Sub
    Set objExcel = Nothing
    The object Selection is an Excel object, so it needs objExcel placed in front of it, which I accomplish using the With ... End With and placing the three red dots.

    Also note there is an Excel branch here at the dbForum.

    good luck,

    oh, yeah, I had an * above - almost forgot. Excel does not like having multiple instances of the application open (although it seems to be getting better with newer versions of office). In older versions, creating an instance of Excel in code, and then later releasing it without closing it first would sometimes create an application error in Windows. So, I always check to see if Excel is open, and if it is, I attach my object variable to the already open application. If not, I create a new one and remember to close it before releasing it.

    have fun,

    tc
    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
  •