How to set Excel chart style in vb - excel

I am exporting an excel chart throught vb.net but I want to change his style. The problem is I'm currently only been able to change his colors.
See the code below:
Private Sub ExportExcel()
Dim PerfilSonho As Boolean = False
If PerfilSonhoAtivo(CB_FuncaoNivel.SelectedItem, CB_CompetenciaNivel.SelectedItem) = True Then 'Ativar barras de Perfil Sonho
PerfilSonho = True
End If
Dim excel As New Excel.Application 'Create Excel Application instance
excel.Visible = True 'Set Excel Application to visible
excel.Workbooks.Add() 'Add a new excel workbook
'Add 3 Columns header for data fields
excel.Range("A1").Value2 = "Operários"
excel.Range("B1").Value2 = CT_Niveis.Series(0).LegendText
If PerfilSonho = True Then
excel.Range("C1").Value2 = CT_Niveis.Series(1).LegendText
End If
'Add data to the Cells
Dim i As Integer = 2
For j As Integer = 0 To CT_Niveis.Series(0).Points.Count - 1
excel.Range("A" & i).Value2 = XChart(j)
excel.Range("B" & i).Value2 = CT_Niveis.Series(0).Points(j).YValues
i += 1
Next
If PerfilSonho = True Then
i = 2
For x As Integer = 0 To CT_Niveis.Series(1).Points.Count - 1
excel.Range("C" & i).Value2 = CT_Niveis.Series(1).Points(x).YValues
i += 1
Next
End If
Dim range As Excel.Range = excel.Range("A1") 'Add range
Dim chart As Excel.Chart = excel.ActiveWorkbook.Charts.Add(After:=excel.ActiveSheet) 'Add Chart
chart.ChartWizard(Source:=range.CurrentRegion, Title:=CT_Niveis.Titles(0).Text) 'Add chart data source & title
'Set Chart Style
chart.ChartStyle = 27
chart.Axes(2, 1).maximumscale = 4.5
chart.Axes(2, 1).minimumscale = 0
End Sub
The Excel is exported like this:
But I wanted to change it to look like this, for example:
Is it even possible? Or we can only change his colors?
Thanks in advance!

As #Mkn commented in this comment section, the following link answered my question: C# - Excel 2013 how to change chart style
Basically, all I had to do was change the chart style from 27 to 209 like this -
chart.ChartStyle = 209
Now the chart looks exactly like I wanted -

Related

Add an Excel Form Control to a file in vb.net

I've got an application written that does a pretty standard dump of a datagridview into an Excel file. The application loops through 12 items and creates a separate sheet in the workbook, then filling in the table using the datagridview.
The export is all good, but what I want to do now is add to every every sheet an additional column that contains a check box on every row in that sheet. It seems the better way to do that is add the form control before the Excel file is saved in the code, but I can't work out if that is possible - Adding a checkbox column to the datagridview doesn't seem to be a viable option.
Code - the dtResults is a datatable filled by a Microsoft SQL query.
Private Sub btnProcess_Click(sender As Object, e As EventArgs) Handles btnProcess.Click
Dim TestsDT As New DataTable
TestsDT.Columns.Add("SvcAbbrev")
TestsDT.Rows.Add("PH.")
TestsDT.Rows.Add("LCFA")
TestsDT.Rows.Add("FAECALP")
TestsDT.Rows.Add("PE-1")
TestsDT.Rows.Add("BGLUC")
TestsDT.Rows.Add("SIGAF")
TestsDT.Rows.Add("CALP")
TestsDT.Rows.Add("HELPFAE")
TestsDT.Rows.Add("M2-PK")
TestsDT.Rows.Add("FAEZONULIN")
TestsDT.Rows.Add("FAEFAESIGA")
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlWorkBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim z As Integer
Dim x As Integer
xlApp = New Microsoft.Office.Interop.Excel.Application
xlWorkBook = xlApp.Workbooks.Add(misValue)
For l = 0 To TestsDT.Rows.Count - 1
txtTest.Text = TestsDT.Rows(l).Item("SvcAbbrev")
dgResults.DataSource = GetResults()
Dim Count As Integer = 0
Count = dgResults.Rows.Count - 1
If Count < 1 Then
Else
Dim ChkBox As New DataGridViewCheckBoxColumn()
ChkBox.HeaderText = "Checkbox"
ChkBox.Name = "Check"
dgResults.Columns.Insert(4, ChkBox)
xlWorkSheet = xlWorkBook.Sheets.Add()
xlWorkSheet.Name = txtTest.Text
xlWorkSheet.Columns.AutoFit()
For z = 0 To dgResults.RowCount - 2
For x = 0 To dgResults.ColumnCount - 1
For y As Integer = 1 To dgResults.Columns.Count
xlWorkSheet.Cells(1, y) = dgResults.Columns(y - 1).HeaderText
xlWorkSheet.Cells(z + 2, x + 1) = dgResults(x, z).Value.ToString()
Next
Next
Next
End If
Next
xlWorkBook.Sheets("Sheet1").Delete
xlWorkSheet.SaveAs("C:\Users\brettf\desktop\test-output.xlsx")
xlWorkBook.Close()
xlApp.Quit()
MessageBox.Show("Processing complete. Excel file should open automatically.", "Processing Complete", MessageBoxButtons.OK, MessageBoxIcon.Information)
Process.Start("C:\Users\brettf\desktop\test-output.xlsx")
Current Output:
Desired Output:
The checkbox has no bearing to anything in the datagridview and will be used once the document is printed by another group of staff within the business.

Read the count of filters in ms project and populate in Excel

I want to create a table in excel which show the count of rows when a filter is applied in ms project. The table should have the filter names as column headers and count of the rows filtered in each column under the header like this
filter 1 filter 2 filter 3
0 10 3
I can write basic macros in excel and ms project.
I use the below to count rows.
applyfilter = fitler1
select all
countFitleredRows = ActiveSelection.Tasks.Count
But how do I read the countFitleredRows for mulitple fitlers and create a table in excel.
If some one has a working macro that would be great.
otherwise I want to know the logic of writing the values in the form of a table in excel.
regards,
Waqas.
Waqas Mahmood,
Although I don't have a macro that does exactly what you want, the following macro will provide a basic structure for creating what you want.
John
Sub BaseCalendarExceptions()
'This macro exports the exceptions for all base calendars in a given Project file
'(modified version of the CalendarExceptions macro published previously in this forum)
' Written by John - Project 2/8/16
Dim MyXL As Object
Set MyXL = CreateObject("Excel.Application")
Dim i As Integer, j As Integer
Dim BC As Calendar
Dim E As Exception
Dim xlRng As Range
'open Excel, define workbook, and set column headers
MyXL.Workbooks.Add
MyXL.Visible = True
MyXL.ActiveWorkbook.Worksheets.Add.Name = "BaseCal Exc Report"
MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Activate
Set xlRng = MyXL.ActiveSheet.Range("A1")
xlRng.Range("A1") = "Proj Cal Holidays"
xlRng.Range("B1") = "Base Calendar"
xlRng.Range("C1") = "Start Date"
xlRng.Range("D1") = "Finish Date"
'Gather and export Project calendar exceptions
j = 0
For Each BC In ActiveProject.BaseCalendars
i = 2 + j
If BC.Exceptions.Count > 0 Then
For Each E In BC.Exceptions
xlRng.Range("A" & i) = E.Name
xlRng.Range("B" & i) = BC.Name
xlRng.Range("C" & i) = E.Start
xlRng.Range("D" & i) = E.Finish
i = i + 1
Next E
End If
j = i
Next BC
MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Columns("A:D").AutoFit
End Sub
The routine creates an Excel file and loops through all the task filters, creating a column for each filter with the name (row 1) and # tasks (row 2).
Sub FilteredTaskCountReport()
Dim appXl As Object
Set appXl = CreateObject("Excel.Application")
appXl.Visible = True
Dim wbk As Object
Set wbk = appXl.Workbooks.Add
Dim wst As Object
Set wst = wbk.Worksheets(1)
Dim CurrentTaskUID As Long
CurrentTaskUID = ActiveCell.Task.UniqueID
OutlineShowAllTasks
Dim f As Variant
Dim c As Integer
c = 0
For Each f In ActiveProject.TaskFilterList
FilterApply f
SelectAll
c = c + 1
wst.Cells(1, c) = f
On Error Resume Next
wst.Cells(2, c) = ActiveSelection.Tasks.Count
If Err.Number <> 0 Then
wst.Cells(2, c) = 0
End If
On Error GoTo 0
Next f
FilterApply "&All Tasks"
Find "Unique ID", "equals", CurrentTaskUID
Set appXl = Nothing
End Sub

Resize Chart ListObject Automatically on PowerPoint with VBA

I want to resize a chart table in PowerPoint via VBA. I've read the following solution multiple times (Resize Listobject Table dynamically with VBA) and it does seem precisely what I need, but for some reason (maybe because I'm running the macro from PowerPoint) it gives me the following error: Automation error (Error 440).
I plan to use the Resize method because I'm updating a PPT chart data table from another Excel file without using the .Activate method (I opted to not use the .Activate because it opened many charts workbooks after the Macro finished execution, even with multiple Waits and Excel.Application.Quit and .Close).
It works great, the charts workbooks do not flash on the screen and the values are copied fast, BUT... the table size is not correct. It only includes the 1st line of the ppt chart data table, and thus my chart is rendered incomplete.
Dim Line As Range Dim financialPartner As String, financialProject As String
financialPartner = excl.Workbooks("HNK-Status-CDAU.xlsx").Sheets("Financial").Cells(int_lin, 2)
financialProject = excl.Workbooks("HNK-Status-CDAU.xlsx").Sheets("Financial").Cells(int_lin, 3)
Dim found As Boolean
found = False
Dim lastRow As Long
Dim financialChart As Chart
Dim financialChartData As Range
Dim financialChartTable As ListObject
Dim financialChartTablews As Worksheet
lastRow = ActiveWindow.Selection.SlideRange.Shapes("RevenuesVolume").Chart.chartData.Workbook.Sheets(1).Range("A1048576").End(xlUp).Row
Set financialChart = ActiveWindow.Selection.SlideRange.Shapes("RevenuesVolume").Chart
Set financialChartTablews = ActiveWindow.Selection.SlideRange.Shapes("RevenuesVolume").Chart.chartData.Workbook.Worksheets(1)
Set financialChartTable = financialChartTablews.ListObjects("Tabela1")
For Each Line In chartDataTable.DataBodyRange.Rows
Dim lineNumber As Long
lineNumber = Line.Row
If ((Line.Columns(1) <> financialPartner) Or (Line.Columns(2) <> financialProject)) And found Then
Exit For
End If
If (Line.Columns(1) = financialPartner) And (Line.Columns(2) = financialProject) Then
found = True
With financialChart.chartData
Set financialChartData = .Workbook.Worksheets(1).ListObjects(1).Range
financialChartData.Range("A" & lastRow).Value = chartDataWs.Cells(lineNumber, 4)
financialChartData.Range("B" & lastRow).Value = chartDataWs.Cells(lineNumber, 5)
financialChartData.Range("C" & lastRow).Value = chartDataWs.Cells(lineNumber, 6)
lastRow = lastRow + 1
financialChartTable.Resize Range("A1:C" & lastRow)
.Workbook.Close
End With
End If
Next
Next

Paste Error Excel to Powerpoint VBA

I am pasting some excel data into powerpoint as a picture and I am having some issues. I have 290 files which I am pasting a table into slide 4, 5 and 6 of each PP file. This worked perfectly yesterday when I was only doing 1 table into slide 6. I have replicated the process and now I keep getting random errors at random times. Sometimes its file 10, others file 50, different everytime. The errors range from the paste datatype is not available OR the clipboard is empty. I have tried every datatype, pasting as a metafile, as a shape, as a picture, just basic pasting and nothing stops the error. I have no idea! Here is my code: PLEASE HELP !
Sub Update_Site_Report()
'Initiate Variables
Dim objPPT As Object
Dim PPTPrez As Object
Dim FinSlide As Object
Dim AssumSlide As Object
Dim RiskSlide As Object
Dim FinTable As Object
Dim AssumTable As Object
Dim RiskTable As Object
Dim fileNameString As String
Dim PicCount As Long
Dim PicCount1 As Long
Dim PicCount2 As Long
Dim i As Long
Dim fileN As String
Dim Directory As String
'Create and open powerpoint application
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Application.ScreenUpdating = False
'Update site report table from spreadsheet
For i = 2 To 291
Sheet20.Cells(18, 2) = Sheet20.Cells(5, i)
Sheet20.Cells(19, 2) = Sheet20.Cells(6, i)
Sheet20.Cells(20, 2) = Sheet20.Cells(7, i)
Sheet20.Cells(21, 2) = Sheet20.Cells(8, i)
Sheet20.Cells(18, 3) = Sheet20.Cells(10, i)
Sheet20.Cells(19, 3) = Sheet20.Cells(11, i)
Sheet20.Cells(20, 3) = Sheet20.Cells(12, i)
Sheet20.Cells(21, 3) = Sheet20.Cells(13, i)
'Take column header from spreadsheet and set as filename
fileN = Sheet20.Cells(4, i)
' Allow directory to be set in excel tab
Directory = Sheet20.Cells(18, 5)
'Open powerpoint presentation at Directory with Filename
Set PPTPrez = objPPT.Presentations.Open(Directory & fileN & ".pptx")
'Set range for site report table
Set Financials = Sheet20.Range("A17:C21")
Set Assumptions = Sheet45.Range("A1:C7")
Set Risks = Sheet45.Range("A24:D41")
'Choose which slide to paste site report table
Set FinSlide = PPTPrez.Slides(6)
Set AssumSlide = PPTPrez.Slides(4)
Set RiskSlide = PPTPrez.Slides(5)
'If there is a table in powerpoint slide, delete the table
For PicCount1 = AssumSlide.Shapes.Count To 1 Step -1
If AssumSlide.Shapes(PicCount1).Type = msoPicture Then
AssumSlide.Shapes(PicCount1).Delete
End If
Next
For PicCount = FinSlide.Shapes.Count To 1 Step -1
If FinSlide.Shapes(PicCount).Type = msoPicture Then
FinSlide.Shapes(PicCount).Delete
End If
Next
For PicCount2 = RiskSlide.Shapes.Count To 1 Step -1
If RiskSlide.Shapes(PicCount2).Type = msoPicture Then
RiskSlide.Shapes(PicCount2).Delete
Debug.Print
End If
Next
'Paste the site report table into the site report
Financials.Copy
FinSlide.Shapes.PasteSpecial ppPasteShape
Set FinTable = FinSlide.Shapes(FinSlide.Shapes.Count)
Assumptions.Copy
AssumSlide.Shapes.PasteSpecial ppPasteShape
Set AssumTable = AssumSlide.Shapes(AssumSlide.Shapes.Count)
Risks.Copy
RiskSlide.Shapes.PasteSpecial ppPasteShape
Set RiskTable = RiskSlide.Shapes(RiskSlide.Shapes.Count)
'Set position of site report table in powerpoint
FinTable.Left = 36
FinTable.Top = 175
FinTable.Width = 614
AssumTable.Left = 36
AssumTable.Top = 80.8
RiskTable.Left = 36
RiskTable.Top = 80.8
RiskTable.Width = 641.5
'Set filename as string
fileNameString = Directory & fileN & ".pptx"
'Save file as filename
PPTPrez.SaveAs fileNameString
'Close powerpoint presentation
PPTPrez.Close
'Repeat for every site (column) - increment i
Next i
'quit powerpoint
objPPT.Quit
Application.ScreenUpdating = True
MsgBox ("Update complete, click ok to exit powerpoint")
End Sub
Disabling Windows clipboard history solves this issue.

Adding SeriesCollection to a Chart with UserForm (combobox)

I am learning to use VBA for excel in Excel 2016. At the moment I am working through an assignment on this website: http://www.homeandlearn.org/vba_charts_and_user_forms.html in which I want to show a scatter-plot of one of the football teams' results. This is done by selecting the team with a combobox in a user form.
The result of the code (see below) ought to be a scatterplot with One line and a title, like this:
http://www.homeandlearn.org/images/vba_charts/chart_arsenal.gif (cannot upload it for some reason)
However, this is the result of my code.
How is it possible that, with the exact same code as on the website, the Chart isn't able to show the selected data and title? I also wonder where the fifth series came from, since I only have four columns.
The code is as follows (and unique to the code described on the website):
Private Sub cmdLoad_Click()
If cbSelect.Text = "Select a chart" Then
MsgBox "Please select a chart"
Exit Sub
End If
Dim MyChart As Chart
Dim ChartData As Range
Dim ChartIndex As Integer
Dim ChartName As String
ChartIndex = cbSelect.ListIndex
Select Case ChartIndex
Case 0
Set ChartData = ActiveSheet.Range("B2:B20")
ChartName = ActiveSheet.Range("B1").Value
Case 1
Set ChartData = ActiveSheet.Range("C2:C20")
ChartName = ActiveSheet.Range("C1").Value
Case 2
Set ChartData = ActiveSheet.Range("D2:D20")
ChartName = ActiveSheet.Range("D1").Value
Case 3
Set ChartData = ActiveSheet.Range("E2:E20")
ChartName = ActiveSheet.Range("E1").Value
End Select
Application.ScreenUpdating = False
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
MyChart.SeriesCollection.NewSeries
MyChart.SeriesCollection(1).Name = ChartName
MyChart.SeriesCollection(1).Values = ChartData
MyChart.SeriesCollection(1).XValues = ActiveSheet.Range("A2:A20")
'Save chart as an image, remove the chart, then set updating screen to ON'
Dim imageName As String
imageName = ThisWorkbook.Path & "\gs16_pictures" & Application.PathSeparator & "TempChart.gif"
MyChart.Export Filename:=imageName, FilterName:="GIF"
ActiveSheet.ChartObjects(1).Delete
Application.ScreenUpdating = True
'Load picture in user form
UserForm1.Image1.Picture = LoadPicture(imageName)
cbSelect is initialized as follows
Private Sub UserForm_Initialize()
cbSelect.AddItem Range("B1") 'Arsenal
cbSelect.AddItem Range("C1") 'Man City
cbSelect.AddItem Range("D1") 'Newcastle
cbSelect.AddItem Range("E1") 'Cardiff
cbSelect.TextAlign = fmTextAlignCenter
End Sub
The problem was in the statement
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
This statement automatically plotted the entire data table. To prevent it, it was necessary to explicitly state the SourceData. Below is the code which you need instead of the lines starting with MyChart.SeriesCollection
With MyChart
.SetSourceData Source:=ChartData
.HasTitle = True
.ChartTitle.Text = ChartName
.SeriesCollection(1).XValues = ActiveSheet.Range("A2:A20")
End With
I am not sure why there is a difference between Excel 2016 and the example from the website. Perhaps Excel is "smarter" than before and interpreted the source data.

Resources