How to set font for excel which is Exported from ACCESS

[rmayur]

Hi,



I made one mdb where records imported from two excel. I have write one query to pull required records from them. I am exporting query result directly to the excel. The default font for excel is MS Sans Serif. But I need the format for excel data is arial. Because some special Character like TM is look like | . So please tell me how do I set font to it. while exporting

[June7]

AFAIK, can't.

I tested export and the new workbook sheet has Calibri font even though I have Excel set to use Arial for new workbooks.

However, the font setting for textboxes in report did export.

So export a report instead of query.

[trevor40]

Hi, if your interested i can provide code for you to manipulate the spreadsheet after it has been exported. you can change or add pretty much anything you can do directly in Excel.
Let me know by replying to this post.

the main jist of it is...
connect to excel
open workbook
show workbook
edit workbook
save and close

heres a small snipit from my code, shown in red is what you may be after.

   Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim Excel_Application As Excel.Application
    Dim Excel_Workbook As Workbook
    Dim gg As String
    gg = "C:\aaa\timesheets\Employee Time Report master.xls"
    Set Excel_Workbook = Workbooks.Open(gg)
    Set Excel_Application = Excel_Workbook.Parent
    Excel_Application.Visible = True
    Excel_Workbook.Worksheets(1).Select
    Excel_Application.DisplayAlerts = False
    sdt = Format(start_date, "dd-mm-yy")
    edt = Format(End_date, "dd-mm-yy")
    Excel_Workbook.SaveAs filename:="C:\aaa\timesheets\Employee Time Report for - " & sdt & " to " & edt & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Excel_Application.DisplayAlerts = True
    'add print preview macro
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Set VBProj = Excel_Workbook.VBProject
    Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
    Dim CodeMod As VBIDE.CodeModule
    Dim CodeMod1 As VBIDE.CodeModule
    Dim LineNum As Long
    Const DQUOTE = """"
    VBComp.Name = "preview"
    Set VBComp = VBProj.VBComponents("preview")
    Set CodeMod = VBComp.CodeModule
    With CodeMod
        LineNum = .CountOfLines + 1
        .InsertLines LineNum, "Sub print_preview"
        LineNum = LineNum + 1
        .InsertLines LineNum, "ActiveWorkbook.Worksheets.PrintPreview"
        LineNum = LineNum + 1
        .InsertLines LineNum, "End Sub"
        LineNum = LineNum + 1
        .InsertLines LineNum, "Sub Send_Mail"
        LineNum = LineNum + 1
        .InsertLines LineNum, "Dim OutlookApp As Object"
        LineNum = LineNum + 1
        .InsertLines LineNum, "Dim OutlookMail As Object"
        LineNum = LineNum + 1
        .InsertLines LineNum, "Set OutlookApp = CreateObject(" & DQUOTE & "Outlook.Application" & DQUOTE & ")"
        LineNum = LineNum + 1
        .InsertLines LineNum, "Set OutlookMail = OutlookApp.CreateItem(0)"
        LineNum = LineNum + 1
        .InsertLines LineNum, "t = ThisWorkbook.FullName"
        LineNum = LineNum + 1
        .InsertLines LineNum, "With OutlookMail"
        LineNum = LineNum + 1
        .InsertLines LineNum, "Application.DisplayAlerts = False"
        LineNum = LineNum + 1
        .InsertLines LineNum, "ActiveWorkbook.Save"
        LineNum = LineNum + 1
        .InsertLines LineNum, "Application.DisplayAlerts = True"
        LineNum = LineNum + 1
        .InsertLines LineNum, ".Attachments.Add(t)"
        LineNum = LineNum + 1
        .InsertLines LineNum, ".Subject = " & DQUOTE & "Employee Time Sheets" & DQUOTE
        LineNum = LineNum + 1
        .InsertLines LineNum, ".Display"
        LineNum = LineNum + 1
        .InsertLines LineNum, "End With"
        LineNum = LineNum + 1
        .InsertLines LineNum, "Set OutlookMail = Nothing"
        LineNum = LineNum + 1
        .InsertLines LineNum, "Set OutlookApp = Nothing"
        LineNum = LineNum + 1
        .InsertLines LineNum, "End Sub"
    End With
    'sort sheet tabs
    Dim x As Long, y As Long
    For x = 1 To Excel_Workbook.Worksheets.Count
        For y = x To Excel_Workbook.Worksheets.Count
            If UCase(Excel_Workbook.Worksheets(y).Name) < UCase(Excel_Workbook.Worksheets(x).Name) Then
                Excel_Workbook.Worksheets(y).Move Before:=Excel_Workbook.Worksheets(x)
            End If
        Next
    Next
    Excel_Workbook.Worksheets(1).Select
    Excel_Workbook.Worksheets.Add                ' Summary
    Excel_Workbook.Worksheets(1).Name = "Summary"
    ' main sheet formatting here
        Excel_Application.DisplayFormulaBar = False
        Excel_Application.ActiveWindow.DisplayGridlines = False
        Excel_Application.ActiveWindow.DisplayHeadings = False
    For sheet_count = 2 To Excel_Workbook.Worksheets.Count
        Set Current_Worksheet = Excel_Workbook.Worksheets(sheet_count)
        Excel_Workbook.Worksheets(sheet_count).Select
        Current_Worksheet.Cells.Select
        With Selection
            Current_Worksheet.Cells.HorizontalAlignment = xlRight
            Current_Worksheet.Cells.Font.Name = "Times New Roman"
        End With
        Current_Worksheet.Range("A1:P1").HorizontalAlignment = xlCenter
        Current_Worksheet.Range("A1:P1").VerticalAlignment = xlCenter
        Current_Worksheet.Range("A1:P1").Font.Bold = True
        Current_Worksheet.Range("C:F").NumberFormat = "h:mm"
        last_cell = Current_Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Address
        rng1 = "A$2:P" & Mid(last_cell, 4, 3)
        ' SORT BY NAME IN THEN DATE IN
        Current_Worksheet.Range(rng1).Sort Key1:=Current_Worksheet.Range("A8"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
        Current_Worksheet.Rows("2:2").Insert Shift:=xlDown
        Current_Worksheet.Range("A3:J3").Copy
        Current_Worksheet.Range("A2:J2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

the code continues for 13 pages of formatting and layout of multiple sheets and a summary, then saves and closes the workbook.

[rmayur]

trevor40

Thanks for the code..... but its huge ...which currently more than my actual use

[rmayur]

June7 .....can you give me some idea how to do export report instead of query

[June7]

Open report, and either click External > Export from the ribbon or open report in Print Preview and right click > Export.

Or use OutputTo method in VBA.