Snippets for Exporting to Excel...

Most code here has been tested and, in some cases, used.  Any code untested will be marked accordingly.  We offer no support for the code or your ability to implement it.  If you require assistance please post in one of the Forums listed here.  It is strongly recommended you test the code in a copy of your database.  In other words, use at your own risk!
Add a Filter to Columns A thru Y...
After Exporting your Data to a Template Rename to Excel Workbook...
Set rst = Nothing
xlWBk.SaveAs "C:/YourDirectory/NewFileName.xlsx", 51
Copy/Paste Cell Values, such as, Formulas...
With XLApp
    .Range("G3").PasteSpecial Paste:=xlPasteValues
End With
Make sure Column maintains its Date/Time Format even after Export...
xlWSh.Range("A:A").NumberFormat = "mm/dd/yyyy hh:mm:ss AM/PM"
Insert a Worksheet from One Workbook into Another Workbook...
Make Columns A thru Y AutoFit to the Values Inserted...
The difficult I do immediately, the impossible takes a little bit longer.
Public Function InsertSP()
On Error GoTo InsertPageErr_Err
     Dim xlapp As Object
     Dim xlWbkNew As Object
     Dim xlWbkOld As Object
     Dim strSheetName As String
        Set xlapp = CreateObject("Excel.Application")
        Set xlWbkNew = xlapp.Workbooks.Open(Forms![frmExport]![txtExportPath] & "/" & Forms![frmExport]![txtNewFileName])
        Set xlWbkOld = xlapp.Workbooks.Open(Forms![frmExport]![txtExportPath] & "/" & Forms![frmExport]![txtOldFileName])
        strSheetName = Forms![frmExport]![txtLDSheetName]
     xlWbkOld.Worksheets(strSheetName).Copy After:=xlWbkNew.Worksheets(xlWbkNew.Worksheets.Count)
     xlWbkNew.Worksheets(strSheetName).Name = Forms![frmExport]![txtNewFileName] & " SP"
     xlWbkOld.Close SaveChanges:=True
     xlWbkNew.Close SaveChanges:=True
   Set xlWbkNew = Nothing
   Set xlWbkOld = Nothing
   DoCmd.Hourglass False
 Exit Function
   MsgBox "Error # " & Err.Number & " This Worksheet already in the specified Workbook!"
 Resume InsertPageErr_Exit
End Function 
Tips (Main)
Creating a Multi-Value field using Alphabet
Copy Fields Down from above Record
Loop thru records and OutPutTo seperate .RTF or .PDF
Modified Spell Check
Code Snippets
Lock\Unlock Bound Controls
Loop while renumbering two columns
Create a Table with Dynamic Field Names
Log Field Changes
Log Record Deletions
Check for Duplicate Values
Selecting an Excel Worksheet from Access
Send eMail to Multiple Recipients
Cancel Save in a Bound Form
Automatically Send eMail Notifications
Looping Records to Send eMail
Check if Table Exists
Insert (or Remove) Blank Line
Click to send feedback...
Public Function fMinAxis(strMeasure As String, strStateID As String) As Double
    'To get Min Axis for Excel Chart
    fMinAxis = Nz(DLookup("MinAxis", "quniMinMax", "Measure='" & strMeasure & "' And pStateID = '" & strStateID & "'"), 20)
End Function
Public Function fMaxAxis(strMeasure As String, strStateID As String) As Double
    'To get Max Axis for Excel Chart
    fMaxAxis = Nz(DLookup("MaxAxis", "quniMinMax", "Measure='" & strMeasure & "' And pStateID = '" & strStateID & "'"), 100)
End Function
Public Function fMajorUnit(strMeasure As String, strStateID As String) As Double
    'To get Major Unit for Excel Chart
    fMajorUnit = Nz(DLookup("lngMajorUnit", "quniMinMax", "Measure='" & strMeasure & "' And pStateID = '" & strStateID & "'"), 10)
End Function
'Select the Chart Object, xlChtOP and then the name of your Chart, OP
Set xlChtOP = xlWBk.Worksheets("Charts").ChartObjects("OP").Chart xlWBk.Worksheets("Charts").ChartObjects("OP").Activate
        With xlChtOP.Axes(2, 1)
            .MinimumScale = fMinAxis("OP", Me.cboStateID)
            .MaximumScale = fMaxAxis("OP", Me.cboStateID)
            .MajorUnit = fMajorUnit("OP", Me.cboStateID)
        End With
Set the Min\Max Axis along with the Major Unit...

Copy and paste the below code into your modUtilities or a new Module (Remember don't name the Module the same as any of the Functions names.)
Within your export routine add (Remember to change the name of the worksheet below, Charts, to the name of your worksheet.)...
Add an Image (Logo) to the worksheet...
'Note, the path to the Image is in column 3 of the Combo Box       
      If Me.cboStateID.Column(2) <> "" Then
            'False      Link to File
            'True       Save with Document
            'All below values are in Points
            'Left       100
            'Top        100
            'Width      70 (pixels) or -1 for original size
            'Height     70 (pixels) or -1 for original size
            xlWBk.Worksheets("Charts").Shapes.AddPicture strLogoPath, False, True, 0, 0, -1, -1
        End If
Function fInsertLogo()
On Error GoTo errHandler
'12.1.2015 Gina Whipp (
'Puts an image (Logo) in the upper right hand corner of first Excel worksheet
    Dim oXL As Object
    Dim xlWorkbook As Object
    Dim xlWorksheet As Object
    Dim strReportPath As String
    Dim strLogoPath As String
    strReportPath = fncSetting(11) & "YourExcelWorkbookNameGoesHere.xlsx"
    strLogoPath = fncSetting(6) & fncSetting(15)
    Set oXL = CreateObject("Excel.Application")
    Set xlWorkbook = oXL.Workbooks.Open(strReportPath)
    Set xlWorksheet = xlWorkbook.Worksheets(1)
        With xlWorksheet.Cells(1, 1)
            xlWorksheet.Shapes.AddPicture strLogoPath, False, True, 1, 1, -1, -1
        End With
    oXL.DisplayAlerts = False
    oXL.DisplayAlerts = True
    Set xlWorkbook = Nothing
    Set oXL = Nothing
    Exit Function
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbInformation + vbOKOnly, "fInsertLogo"
    Resume Exit_fInsertLogo
End Function
Call it using a Function (For fncSetting() click the code tags below.)...
Merge Cells...

Merge and Center Cells...
xlWSh.Range("A1:C1").HorizontalAlignment = xlCenter 'For Horizontal
xlWSh.Range("A1:D1").VerticalAlignment = xlCenter 'For Vertical

Or Unmerge the Cells
xlWSh.Range("B1").UnMerge 'You pick a cell within the range of the ones that you have

Merge Columns...
This site uses cookies to collect data on usage. By continuing to browse this site you consent to this policy. Find out more here.