I am trying to make a fairly easy macro to activate the next series in an already active chart. (my main macro contains all the formatting stuff).
Problem with this coding, is that i am not able to assign the current active series (already selected in the graph in excel). In a graph with n series (SeriesCollection.Count = n) I want to go from x, to x+1 and if x=n i want to go back to series 1 (so the for/next included here is not necessary if I get the macro to work as intended).
Sub NextButton_Click()
Dim cht As Chart
Set cht = ActiveChart
If cht Is Nothing Then
MsgBox "Select a chart."
Exit Sub
End If
With cht
For SrsIndx = 1 To .SeriesCollection.Count
.SeriesCollection(SrsIndx).Select
Next SrsIndx
End With
End Sub
For Simple graphs, just use PlotOrder: If you are not using a Combo Chart (i.e. not mixing Line and Bar charts, and not using the Secondary Axis), then you can just use the following code:
IIF(TypeName(Selection)="Series", Selection.PlotOrder, -1)
This will return -1 if you do not have a Series selected.
However, this is actually the order within the ChartGroup - the conditions above were for when there is only 1 ChartGroup on the Chart.
Otherwise, try using Name and a loop:
Function ActiveSeriesNumber(ThisSeries AS Series) AS Long
Dim ThisChart AS Chart, TestNumber AS Long
ActiveSeriesNumber = -1
On Error GoTo FunctionError
Set ThisChart = ThisSeries.Parent.Parent 'Object Model Is Chart.ChartGroup.Series
For TestNumber = 1 to ThisChart.SeriesCollection.Count
If ThisChart.SeriesCollection(TestNumber).Name = ThisSeries.Name THen
ActiveSeriesNumber = TestNumber
Exit Function
End If
Next TestNumber
FunctionError:
On Error GoTo -1
End Function
Use this by calling ActiveSeriesNumber(Selection)
Here's the General Idea. Step through that code and you can see each series gets selected. You'll need add some object validation as this assumes the selected object is a Series.
Sub CycleSeries()
Dim MyObject As ChartObject
Dim MyChart As Chart
Dim SerCol As SeriesCollection
Dim SelSeries As Series
Dim indexSeries As Series
Dim ChartSheet As Worksheet
Dim x As Integer
Set ChartSheet = ThisWorkbook.Sheets(1)
Set MyObject = ChartSheet.ChartObjects(1)
Set MyChart = MyObject.Chart
Set SerCol = MyChart.SeriesCollection
Set SelSeries = Excel.Application.Selection
For x = 1 To SerCol.Count
Set indexSeries = SerCol(x)
If indexSeries.Name = SelSeries.Name Then
If (x = SerCol.Count) Then
Set SelSeries = SerCol(1)
SelSeries.Select
Exit For
Else
Set SelSeries = SerCol(x + 1)
SelSeries.Select
Exit For
End If
End If
Next x
End Sub
Related
I have a Word file with approximately 10 pages and 20 tables. Some of these tables have checkboxes. I want to copy these tables into an Excel file.
The following code copies all tables from my Word file into my Excel file:
Sub Import()
Option Explicit
Dim wb As Workbook
Dim sh As Worksheet
Dim sheet As Worksheet
Dim lzeile As Integer
Set wb = ActiveWorkbook
Set sh = wb.ActiveSheet
Set sheet = wb.Worksheets("Tabelle1")
Dim Btxt As Object
Set Btxt = CreateObject("Word.Application")
Btxt.Visible = True
Btxt.documents.Open "C:\Users\*.doc" '*=path
lzeile = 0
For i = 1 To 20
Btxt.ActiveDocument.Tables(i).Range.Copy
Application.Goto sheet.Cells(1 + lzeile, 1)
sheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
lzeile = sheet.Cells(Rows.Count, 1).End(xlUp).Row
lzeile = lzeile + 1
sheet.Cells(lzeile, 1) = "Tabelle" & i
Next i
Btxt.Quit
Set Btxt = Nothing
Set wb = Nothing
Set sh = Nothing
End Sub
It does not copy checkboxes or the value (0 = not checked / 1 = checked) of the checkbox.
I can write the value of a checkbox into a cell in my excel sheet with this line:
sheet.Cells(j, 10) = Btxt.ActiveDocument.Tables(i).FormFields.Item("Kontrollkästchen" & j).Result
With a loop j over all "Kontrollkästchen" (german translation of contentcontrol or formfield item) so basically the name of all formfield items in this Word file.
How can I get the position of these formfield items or identify which formfield item / ContentControl is in which table?
I tried to go through all rows and columns in each table because none of them are larger than 10x10. But I can´t find a way to check if a checkbox is maybe in table 3 on column 5 row 5 and then read the name of this checkbox to a safe the value (0 / 1) in the Excel cell on the same position in my copied table.
The solution depends on whether they're formfields or content controls.
Assuming they're formfields:
Sub Demo()
Dim i As Long, j As Long, Rng As Range
With ActiveDocument
For i = .FormFields.Count To 1 Step -1
With .FormFields(i)
If .Type = wdFieldFormCheckBox Then
j = Abs(.CheckBox.Value)
Set Rng = .Range
.Delete
Rng.Text = j
End If
End With
Next
End With
End Sub
Assuming they're content controls:
Sub Demo()
Dim i As Long, j As Long, Rng As Range
With ActiveDocument
For i = .ContentControls.Count To 1 Step -1
With .ContentControls(i)
If .Type = wdContentControlCheckBox Then
j = Abs(.Checked)
Set Rng = .Range
.Delete
Rng.Text = j
End If
End With
Next
End With
End Sub
For the sake of simplicity and clarity, the sample code below leaves out the parts having to do with Excel, as well as creating the instance of the Word Application. It shows only how to access the Word document's checkboxes and convert those to static values.
At the end, also, the document is closed without saving changes, which means forms protection and the checkboxes should be left intact - the macro will not have affected them.
Note: You should have Option Explicit at the top of the code page, not inside a "Sub".
How it works
The document to be processed is opened and at that moment set to an object (doc). Use this instead of ActiveDocument as it will be much clearer and, in case the user would try to do something, won't affect macro execution.
If the document has forms protection, this must be turned off in order to delete the checkboxes and insert static values.
Then all the form fields are looped. If they are checkboxes, the value is determined, the checkbox removed and the value assigned to the range the checkbox occupied.
After this has completed comes the code to transfer data to Excel. Then the document is closed without saving changes.
Sub ConvertCheckBoxesToValues()
Dim ff As Object ' Word.FormField
Dim doc As Object ' Word.Document
Dim cbValue As String
Dim rngFF As Object ' Word.Range
Set doc = Btxt.Documents.Open("C:\Users\*.doc") '*=path
If doc.ProtectionType <> -1 Then 'wdNoProtection
doc.Unprotect
End If
For Each ff In doc.FormFields
If ff.Type = 71 Then 'wdFieldFormCheckBox
If ff.CheckBox.value = True Then
cbValue = "1"
Else
cbValue = "0"
End If
Set rngFF = ff.Range
ff.Delete
rngFF = cbValue
End If
Next
'Transfer the information to Excel, then
doc.Close 0 'wdDoNotSaveChanges
End Sub
I'm currently trying to add a data label to only the last point of each series in each graph on a worksheet. I'm currently adapting one of the solutions proposed here: "https://superuser.com/questions/1285179/adding-data-label-only-to-the-last-value".
However, my code keeps on popping up with the error: "Runtime error '13', type mismatch". When I go in debug mode, it higlights the line "Set chrt = ws.ChartObjects(Chart_Name)".
Sub LastDataLabel()
Dim Chart_Name As String
Dim i, Total_Charts, Total_Series As Integer
Dim ws As Worksheet
Dim chrt As Chart
Dim srs As Series
Dim pnt As Point
Dim p As Integer
Application.ScreenUpdating = False
Set ws = ActiveSheet
Total_Charts = Range("C12").Value
For i = 1 To Total_Charts
Chart_Name = ActiveSheet.Cells(14 + i, 2).Value 'A list of all chart names exists along this range
Set chrt = ws.ChartObjects(Chart_Name)
Total_Series = chrt.SeriesCollection.Count
For j = 1 To Total_Series
Set srs = chrt.SeriesCollection(j)
srs.ApplyDataLabels
For p = 1 To srs.Points.Count - 1
Set pnt = srs.Points(p)
pnt.DataLabel.Text = ""
Next
srs.Points(srs.Points.Count).DataLabel.Format.TextFrame2.TextRange.Font.Size = 10
srs.Points(srs.Points.Count).DataLabel.Format.TextFrame2.TextRange.Font.Name = "Arial"
Next j
Next i
End Sub
Any and all help is greatly appreciated. Thank you!
ChartObject is just a container shape for the chart - it's not the actual chart itself
This should improve things:
Set chrt = ws.ChartObjects(Chart_Name).Chart
My code is working fine but it ends up giving me a runtime error "object required.
I am not able to find out what is causing this error. This code is related to deleting graphs that don't have any data in them .
Sub HideEmptyCharts()
Dim wksCharts As Worksheet
Dim objCO As ChartObject
' Set up a variable for the worksheet containing the charts
Set wksCharts = ThisWorkbook.Sheets("Report output")
' Loop through every embedded chart object on the worksheet
For Each objCO In wksCharts.ChartObjects
' Make each one visible
objCO.Visible = True
' If the chart is empty make it not visible
If IsChartEmpty(objCO.Chart) Then objCO.Visible = False
Next objCO
End Sub
Private Function IsChartEmpty(chtAnalyse As Chart) As Boolean
Dim i As Integer
Dim j As Integer
Dim objSeries As Series
' Loop through all series of data within the chart
For i = 1 To chtAnalyse.SeriesCollection.Count
Set objSeries = chtAnalyse.SeriesCollection(i)
' Loop through each value of the series
For j = 1 To UBound(objSeries.Values)
' If we have a non-zero value then the chart is not deemed to be empty
If objSeries.Values(j) <> 0 Then
' Set return value and quit function
IsChartEmpty = False
Exit Function
End If
Next j
Next i
IsChartEmpty = True
End Function
Change the object passed to the function from Chart to full ChartObjectlike this:
Private Sub HideEmptyCharts()
Dim wksCharts As Worksheet
Dim objCO As ChartObject
Set wksCharts= ThisWorkbook.Sheets("Report output")
For Each objCO In wksCharts.ChartObjects
objCO.Visible = True
If IsChartEmpty(objCO) Then objCO.Visible = False
Next objCO
End Sub
Private Function IsChartEmpty(co As ChartObject) As Boolean
Dim i As Integer
Dim j As Integer
Dim objSeries As Series
For i = 1 To co.Chart.SeriesCollection.Count
Set objSeries = co.Chart.SeriesCollection(i)
For j = 1 To UBound(objSeries.Values)
If objSeries.Values(j) <> 0 Then
IsChartEmpty = False
Exit Function
End If
Next j
Next i
IsChartEmpty = True
End Function
An outdated pivotcache and some still remembered but in the meantime missed items caused some trouble to me in the past. So I propose to add this code once before:
Dim pc As PivotCache
For Each pc In ThisWorkbook.PivotCaches
pc.MissingItemsLimit = xlMissingItemsNone
pc.Refresh
Next pc
I am writing a program to create a new excel book with a graph/chart. This chart will have multiple series (that will vary in number) with multiple graph types, but I am having a hard time using a for loop to create the series. Here is what I have so far:
Dim Dataseries As Excel.Series = CType(chartPage.SeriesCollection(), Excel.Series)
For index As Integer = 0 To GlobVars.filenameArr.Length
Dataseries(index).Name = GlobVars.filenameArr(index)
Next index
When I try to run this code I get the error:
Excel.Series cannot be indexed because it has no default property
I think you need something like this
Dim ChartObject = CType(excelWorkSheet.ChartObjects("Diagramm 1"), ChartObject)
Dim Chart = calibrationChartObject.Chart
Dim seriesCollection = CType(calibrationChart.SeriesCollection(), SeriesCollection)
' loop to create new series
For each fileName in GlobVars.filenameArr
Dim testSerie As Excel.Series = seriesCollection.NewSeries()
'Add values and customize the serie
With testSerie
.Values = New Double() {someValue, someValue}
.XValues = New Double() {someValue, someValue}
.Border.LineStyle = XlLineStyle.xlDot
.Border.Color = Color.Red
.MarkerStyle = XlMarkerStyle.xlMarkerStyleNone
.Name = fileName
End With
Next
Don't forget to release all references to excel objects after you are done or Excel will not close. Can't test it right now, but I think it should work.
I am having two charts in an excel sheet ("DesiredData"), and my purpose is to determine the chart having a greater value of Maximum Scale on Y-axis and then changing the value of Maximum Scale in the other chart. My code is :
Sub reArrange()
With ThisWorkbook.Sheets("DesiredData")
Dim maxScale1 As Long
Dim maxScale2 As Long
.ChartObjects(1).Activate
'runtime error at this line
ActiveChart.Axes(xlValue, xlPrimary).Activate
maxScale1 = .ChartObjects(1).Axes(xlValue, xlPrimary).MaximumScale
.ChartObjects(2).Activate
ActiveChart.Axes(xlValue, xlPrimary).Activate
maxScale2 = .ChartObjects(2).Axes(xlValue).MaximumScale
If maxScale1 > maxScale2 Then
.ChartObjects(2).Activate
.ChartObjects(2).Axes(xlValue).MaximumScale = maxScale1
Else
.ChartObjects(1).Activate
.ChartObjects(1).Axes(xlValue).MaximumScale = maxScale2
End If
End With
End Sub
It is giving Run-Time error the specified line, please help me out.
something like this
Dim c As ChartObject
Dim c2 As ChartObject
Dim a1 As Axis
Dim a2 As Axis
Set c = Worksheets("Sheet1").ChartObjects(1)
Set c2 = Worksheets("Sheet1").ChartObjects(2)
Dim x As Chart
Set x = c.Chart
Set a1 = x.Axes(XlAxisType.xlValue, xlPrimary)
Set x = c2.Chart
Set a2 = x.Axes(XlAxisType.xlValue, xlPrimary)
a1.MaximumScale = a2.MaximumScale
Your code almost works, if you remove some unnecessary .Activate commands. First of all, you can't activate an axis, only select it. Second of all, there's no need to select an axis or activate a chart to do what you want. You do need to insert .Chart between .ChartObjects(i) and .Axes(xlValue).
The following ought to work as expected:
Sub reArrange()
Dim maxScale1 As Long
Dim maxScale2 As Long
With ThisWorkbook.Sheets("DesiredData")
maxScale1 = .ChartObjects(1).Chart.Axes(xlValue, xlPrimary).MaximumScale
maxScale2 = .ChartObjects(2).Chart.Axes(xlValue).MaximumScale
If maxScale1 > maxScale2 Then
.ChartObjects(2).Chart.Axes(xlValue).MaximumScale = maxScale1
Else
.ChartObjects(1).Chart.Axes(xlValue).MaximumScale = maxScale2
End If
End With
End Sub