1

In MS Access I have a database. I have Form with three TextBoxes and one Command Button.

  • In txttask_plot user writes Plotid
  • In txttask_from user selects date1
  • In txttask_to user selects date2

The chart is in Sheet1 with chart 1 name. The query is in sheet2 with query name.

In the Command button, I have the following code which exports a query to Excel and graphs all data on an xlColumnStacked plot.

Sub cmdTransfer_Click()
    Dim sExcelWB As String
    Dim xl As Object ''Excel.Application
    Dim wb As Object ''Excel.Workbook
    Dim ws As Object ''Excel.Worksheet
    Dim ch As Object ''Excel.Chart
    Dim myRange As Object

    Set xl = CreateObject("excel.application")
    sExcelWB = "D:\testing2\" & "_qry_task.xls"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_mb_costo_jorn_tarea", sExcelWB, True
    Set wb = xl.Workbooks.Open(sExcelWB)

    'Sheets are named with the Access query name
    Set ws = wb.Sheets("qry_task")

    Set ch = xl.Charts.Add
    ch.ChartType = xlColumnClustered

    xl.Visible = True
    xl.UserControl = True
End Sub

From here I am using all the code in Excel.

  • How can I use such code in the MS Access Command Button?
  • For my chart, how can I select Range("C2:D" & i-1)?
  • How do I add a secondary y-axis?
  • How to add the Main Title and how to add a Subtitle below Main Title?

The second set of (x,y) values is (task, cost) has a range of >18.000 to "n " which I want on the secondary y-axis.

Also, I need to insert a primary title on top and a secondary title beneath

I have this code for titles

'Main Title from sheet "qry_task" in top of the Chart
    .HasTitle = True
    .ChartTitle.Text = Range("A1").Value & " " & Range("A2").Value & " " & Range("D1").Value
    .Axes(xlValue).MajorGridlines.Delete
    .Axes(xlCategory, xlPrimary).HasTitle = False
    .Axes(xlValue, xlPrimary).HasTitle = False

'SubTitle below First Title from Sheet qry_task
From txtboxes from the Form.
(txt_from – txt_to)

'chart_position_upper_left_corner Macro
With ActiveSheet.Shapes("Chart 1")
    .Left = Range("A1").Left
    .Top = Range("A1").Top
End With

ActiveSheet.Shapes("Chart1").IncrementLeft -375.75
ActiveSheet.Shapes("Chart 1").IncrementTop -96
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.3354166667, msoFalse, _
    msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.3177085156, msoFalse, _
    msoScaleFromTopLeft

'insert secundary axis()   
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.PlotArea.Select
ActiveChart.FullSeriesCollection(2).Select
ActiveChart.FullSeriesCollection(2).AxisGroup = 2
ActiveChart.FullSeriesCollection(2).Select
ActiveChart.FullSeriesCollection(2).ChartType = xlLineMarkers
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.ChartGroups(1).GapWidth = 69
ActiveChart.FullSeriesCollection(2).Select
Application.CommandBars("Format Object").Visible = False
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.5180265655, msoFalse, _
    msoScaleFromTopLeft

Chart labels

'Chart labels
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.1797101449, msoFalse, _
    msoScaleFromTopLeft
ActiveChart.FullSeriesCollection(2).Select
ActiveChart.ChartGroups(1).GapWidth = 48
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.SetElement (msoElementDataLabelShow)
ActiveChart.SetElement (msoElementDataLabelInsideBase)
ActiveChart.FullSeriesCollection(1).DataLabels.Select

With Selection.Format.TextFrame2.TextRange.Font.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
End With

'Edit Font
Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue

With Selection.Format.TextFrame2.TextRange.Font
    .NameComplexScript = "Arial"
    .NameFarEast = "Arial"
    .Name = "Arial"
End With
End Sub

I've searched the web for a quite a while but can't quite put my finger on the right syntax: VBA Excel to VBA Access. I need to run all the code from the Command Button on the MS Access Form.

3
  • Just replace the ActiveSth objects with an explicit reference to the Excel-Object and the Workbook. etc. ,like you have done in cmdTransfer_Click(), but you are wrong here. This question belongs to stackoverflow.com, I will flag it for being moved. Commented Aug 24, 2018 at 0:55
  • Could you give me here an example of how to replace ActiveSth objects with an explicit reference to the Excel Object and the Workbook? I am learning to program in VBA. Commented Aug 24, 2018 at 1:10
  • Look at the xl, wbandwsobjects of cmdTransfer_Click() thats the trick. Commented Aug 24, 2018 at 1:13

1 Answer 1

0

Seems I was wrong and you can refer to ActiveSth objects from outside.

This code needs a reference to Microsoft Excel xy.0 Object Libary and Microsoft Office xy.0 Object Libary in "VBA-Editor -> Tools -> References" or define the Excel enums explicit (e.g. xlLineMarkers)

Sub cmdTransfer_Click()
Dim sExcelWB As String
Dim xl As Object ''Excel.Application
Dim wb As Object ''Excel.Workbook
Dim ws As Object ''Excel.Worksheet
Dim ch As Object ''Excel.Chart
Dim myRange As Object

Set xl = CreateObject("excel.application")
sExcelWB = "D:\testing2\" & "_qry_task.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_task", sExcelWB, True
Set wb = xl.Workbooks.Open(sExcelWB)

'Sheets are named with the Access query name
Set ws = wb.Sheets("qry_task")

Set ch = xl.Charts.Add
ch.ChartType = xlColumnClustered
with ch
    'Main Title from sheet "qry_task" in top of the Chart
    .HasTitle = True
    .ChartTitle.Text = ws.Range("A1").Value & " " & ws.Range("A2").Value & " " & ws.Range("D1").Value
    .Axes(xlValue).MajorGridlines.Delete
    .Axes(xlCategory, xlPrimary).HasTitle = False
    .Axes(xlValue, xlPrimary).HasTitle = False
End With
'SubTitle below First Title from Sheet qry_task
'From txtboxes from the Form.
'(txt_from – txt_to)

'chart_position_upper_left_corner Macro
With wb
    .ActiveSheet.Shapes("Chart 1")
    .Left = .Range("A1").Left
    .Top = .Range("A1").Top


.ActiveSheet.Shapes("Chart1").IncrementLeft -375.75
.ActiveSheet.Shapes("Chart 1").IncrementTop -96
.ActiveSheet.Shapes("Chart 1").ScaleWidth 1.3354166667, msoFalse, _
    msoScaleFromTopLeft
.ActiveSheet.Shapes("Chart 1").ScaleHeight 1.3177085156, msoFalse, _
    msoScaleFromTopLeft

'insert secundary axis()   
.ActiveSheet.ChartObjects("Chart 1").Activate
.ActiveChart.PlotArea.Select
.ActiveChart.FullSeriesCollection(2).Select
.ActiveChart.FullSeriesCollection(2).AxisGroup = 2
.ActiveChart.FullSeriesCollection(2).Select
.ActiveChart.FullSeriesCollection(2).ChartType = xlLineMarkers
.ActiveChart.FullSeriesCollection(1).Select
.ActiveChart.ChartGroups(1).GapWidth = 69
.ActiveChart.FullSeriesCollection(2).Select
.Application.CommandBars("Format Object").Visible = False
.ActiveSheet.Shapes("Chart 1").ScaleWidth 1.5180265655, msoFalse, _
    msoScaleFromTopLeft
'Chart labels

'Chart labels
.ActiveSheet.Shapes("Chart 1").ScaleHeight 1.1797101449, msoFalse, _
    msoScaleFromTopLeft
.ActiveChart.FullSeriesCollection(2).Select
.ActiveChart.ChartGroups(1).GapWidth = 48
.ActiveChart.FullSeriesCollection(1).Select
.ActiveChart.SetElement (msoElementDataLabelShow)
.ActiveChart.SetElement (msoElementDataLabelInsideBase)


With wb.ActiveChart.FullSeriesCollection(1).DataLabels.Format.TextFrame2.TextRange.Font.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid


'Edit Font
.Format.TextFrame2.TextRange.Font.Bold = msoTrue

With .Format.TextFrame2.TextRange.Font
    .NameComplexScript = "Arial"
    .NameFarEast = "Arial"
    .Name = "Arial"
End With
End With
End Sub

Try this, not tested, just a quick hack, maybe some end with , etc are missing.

3
  • ComputerVersteher I really appreciate your reply First,I have been tested the code: Commented Aug 24, 2018 at 15:25
  • ComputerVersteher. I really appreciate your reply First, I tested the code for Main Title and any time ERROR 1004 is displayed in this line: .ChartTitle.Text = Range("B1").Value & " " & Range("B2").Value & " " & Range("E1").Value I think ERROR occurs because such Ranges are in sheet "qry_task". I don’t know how to reference such ranges to "qry_task" Sheet. Please, can you tell me how to fix such ERROR 1004 Commented Aug 24, 2018 at 15:39
  • @SebastianSalazar Sorry missed that (and the missing enums). See updated answer. Commented Aug 24, 2018 at 17:09

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .