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.

  • 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. – ComputerVersteher Aug 24 '18 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. – Sebastian Salazar Aug 24 '18 at 1:10
  • Look at the xl, wbandwsobjects of cmdTransfer_Click() thats the trick. – ComputerVersteher Aug 24 '18 at 1:13
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.

  • ComputerVersteher I really appreciate your reply First,I have been tested the code: – Sebastian Salazar Aug 24 '18 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 – Sebastian Salazar Aug 24 '18 at 15:39
  • @SebastianSalazar Sorry missed that (and the missing enums). See updated answer. – ComputerVersteher Aug 24 '18 at 17:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.