MSAccess - Excel Automation - Inserting Comments

Hello markp99,

Yes, you can.  Please post the code you have now, and how to determine the cell(s) that should
get comments.

I may not be back for several hours, BTW...

Regards,

Patrick

Sorry,

The code is a bit convoluted,.  I have <<snipped>> extraneous formatting commands to shorted just a bit.  Hope this is useful:

Private Sub btnXLS_Click()

'On Error GoTo XLSError

    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim PRM As DAO.Parameter
    Dim strSQL As String
   
    Dim appXLS As Excel.Application
    Dim wbknew As Excel.Workbook
    Dim wksnew As Excel.Worksheet
   
    Set appXLS = CreateObject("Excel.Application")
    appXLS.SheetsInNewWorkbook = TotalSheets
    Set wbknew = appXLS.Workbooks.Add
    Set wksnew = wbknew.ActiveSheet
   
    appXLS.Visible = True
    appXLS.UserControl = True
 
    wbknew.Colors(38) = RGB(255, 0, 102)
    wbknew.Colors(46) = RGB(255, 153, 51)

    strSQL = "SELECT DISTINCT [Q Module].Module, Assemblies.[Assembly Name], Assemblies.ShortName FROM [Q Module] INNER JOIN Assemblies ON ([Q Module].Module = Assemblies.Assembly) AND ([Q Module].Assy = Assemblies.Assy) AND ([Q Module].Program = Assemblies.Program);"

    Set db = CurrentDb
    Set qdf = db.CreateQueryDef("", strSQL)

    qdf.Parameters("[Forms]![dms_kb]!txtAssy]") = Forms!dms_kb!txtAssy
    qdf.Parameters("[Forms]![dms_kb]!txtProgram]") = Forms!dms_kb!txtProgram

    Set rs1 = qdf.OpenRecordset(dbOpenSnapshot)

    counter = 0
    With rs1
        If .RecordCount <> 0 Then
            Do While Not rs1.EOF
                counter = counter + 1
                thisModule = rs1!Module
                thisName = rs1![Assembly Name]
                thisShortName = rs1![ShortName]
                Set qdf2 = db.QueryDefs("Status - Report_Module")
                qdf2.Parameters("[Forms]![dms_kb]!txtAssy") = Forms!dms_kb!txtAssy
                qdf2.Parameters("[Forms]![dms_kb]!txtProgram") = Forms!dms_kb!txtProgram
                qdf2.Parameters("[Forms]![dms_kb]!txtTask") = thisModule

                Set rs2 = qdf2.OpenRecordset(dbOpenSnapshot)
           
                RecordCount = rs2.RecordCount + 6
               
                wbknew.Sheets(counter).Name = thisShortName
                Set wksnew = wbknew.Worksheets(counter)
               
                'XLS PageSetup (margins, headers, footers, landscape, freezepanes)
                wbknew.Sheets(counter).Select
                wksnew.Range("b2") = "Building Health Status Report..."
                wksnew.Range("d7").Select
                appXLS.ActiveWindow.FreezePanes = True
                wksnew.PageSetup.PrintArea = ""
                wksnew.PageSetup.Zoom = 75
                appXLS.ActiveWindow.DisplayGridlines = False
                With appXLS.ActiveSheet.PageSetup
                    .Orientation = xlLandscape
                    .LeftFooter = "&8 Health Status Report - &D"
                    .RightFooter = "&8 & Page  &P  of  &N"
                    .LeftMargin = appXLS.InchesToPoints(0.25)
                    .RightMargin = appXLS.InchesToPoints(0.25)
                    .TopMargin = appXLS.InchesToPoints(0.25)
                    .BottomMargin = appXLS.InchesToPoints(0.5)
                    .FooterMargin = appXLS.InchesToPoints(0.25)
                    .PrintTitleRows = appXLS.ActiveSheet.Range("A1:A6").Address
                    .PrintGridlines = False
                End With


                With wksnew
<<snip formatting stuff>>                
                     .Range("b7").CopyFromRecordset rs2
                End With
               
<<snip formatting stuff>>                
           
            .MoveNext
        Loop
    End If
   
wbknew.Sheets(1).Select



End With

Exit Sub

XLSError:

MsgBox "The report build process is incomplete.  Exiting.    "

End Sub

Note there are multiple XLS tabs being created by this routine...

You would not use any method such as .CopyFromRecordset, but instead open your recordset and fill the cells one by one. While doing this, monitor your field "Comment" or the field that may contain "X" and add the comment right after setting the value of the cell. You can use this function for nice and clean comments:

Sub CreateComment(prngCell As Range, strComment As String)
   
    With prngCell.AddComment
        .Visible = False
        .Text Text:=Replace(strComment, vbCrLf, vbLf)
        With .Shape
            With .TextFrame.Characters.Font
                .Name = "Tahoma"
                .FontStyle = "Regular"
                .Size = 8
                .ColorIndex = 49
            End With
            .TextFrame.AutoSize = True
            .Fill.ForeColor.SchemeColor = 26
            .Line.ForeColor.SchemeColor = 56
            .Shadow.ForeColor.SchemeColor = 49
        End With
    End With

End Sub

Adjust to your colour scheme, naturally. I find the default comments to be especially ugly, and the missing AutoSize is a real pain (not to mention the silly bold title).

Good luck!
(°v°)

harfang said:
>>You would not use any method such as .CopyFromRecordset, but instead open your recordset
>>and fill the cells one by one.

Markus,

Not sure I agree.  Using CopyFromRecordset is very fast, and if the rule(s) for what cells get
comments are not too complicated, then using the Find method or an AutoFilter to locate
them will go much, much faster than populating cells one by one.

Regards,

Patrick

markp99,

You still have not elaborated on ow to determine which cells get the Comments...

Regards,

Patrick

Well I agree, CopyFromRecordset is fast, when it works at all (which is rarely the case), and when the result is correct (as it is for simple cases). I had too many problems with it to consider it any longer.

However, I do tend to fill a large array in memory and populate an Excel range in one go from the array. Same speed and none of the bugs.

If such a method is used, you can make a second pass over the recordset. The .AbsolutePosition can be used to identify the correct row and thus the cell in which to add the comment. Comments cannot be added in bulk, which is why a loop is needed here.

I didn't want to go into those special techniques, which are a bit outside of the central question: "how to add comments from code", which nobody had answered. But perhaps I could have said "to add comments, you cannot use CopyFromRecordset; you will have to..."

Regards,
(°v°)

Sorry for my late reply,

The values of the cells are not pulled from a table directly, they are "calculated" based on some conditions included in the queries.  I uses a series of queries unioned to produce the coded value columns.  Each column represents a different table sharing a common PK (PartNumber).  

The value of "X" is present when a series of conditions are met.  Example from the query:

PAR: IIf(Sum([PARResult])=0,"n/a",IIf(Sum([PARResult])<100,"OK",IIf(Sum([PARResult])<1000,"O","X")))

I do use CopyFromRecordset using the union query to populate the XLS sheet with the initial cell values.  

Would I make a 2nd pass with a CopyFomrRecordset to populate Comments, or would this simply overwrite the cell values?  What would this approach look like?

Testing cell-by-cell seems a brute force approach, but do-able.  I can pick up the PK and cell value walking thru the XLS row-by-row, column-by-column.  This info would be used to DLookup the value to be used in the Comment.  

Any suggestions using CopyFromRecordset method or the cell-by-cell method?


Thanks!

Thanks harfang,

I'm with you on the approach to rewind the recordset.

I'm hanging up on the following:

            CreateComment rngTL.Offset(rec.AbsolutePosition, 12), "Here's an X"

Are you calling the CreateComment function noted above, or is this some other/existing function?  What is the expected format of rngTL?

Thanks!

Like this?

            CreateComment Range("b7").Offset(rec.AbsolutePosition, 12), "Here's an X"

Harfang,

Here is what I used, which seems to do wha I want:

                rs2.MoveFirst
                ccount = 0
                Do Until rs2.EOF
                    If rs2!DPA = "X" Then
                        wksnew.Range("M" & ccount + 7).AddComment
                        wksnew.Range("M" & ccount + 7).Comment.Text Text:="Here is an 'X'"
                    End If
                    rs2.MoveNext
                    ccount = ccount + 1
                Loop

Do you thing there is a more efficient approach?  This seems to work fine, but I worry when I scale it up.  My XLS workbook has 8 tabs, each tab has 20-200 rows, 15 columns to evaluate for "X".

I heard from another developer that there is a limit on the number of comments in a worksheet, at about 60'000. I couldn't confirm this (and don't want to run the test just for the fun of it...)

At most, you have 200*15 "X"'s. I feel confident that Excel can handle 3000 comments in a sheet. You might want to turn off screen updating, but you do need to create them one-by-one.

And yes, your approach is what I was thinking. The CreateComment was indeed the function I posted earlier (but you can get the default comments using your two lines of code just as well), and rngTL is -- as you found out -- a range pointing at the top left of your data. From there, .Offset is used to find the cell containing the "X" from the recordset.

Cheers!
(°v°)