I need to find a way to extract chart data labels from a PowerPoint chart to Excel, as many times the PowerPoint chart given to me has it's linked data broken.
I wrote the code below, but I have no clue what to do after For Each datapoint In chtnow.SeriesCollection(1).Points...
Sub Extract_Datalabels()
'Goal: To extract datalabels of Chart's series collection and write to excel
Dim datapoint As Point
Dim sh As Shape
Dim sld As Slide
Dim chtnow As Chart
Dim label As DataLabel
Dim xlApp As New Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlworksheet As Excel.Worksheet
Set xlWorkbook = xlApp.Workbooks.Add
Set xlworksheet = xlWorksheets.Add
xlApp.Visible = True
Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart
For Each datapoint In chtnow.SeriesCollection(1).Points
'Extract data labels
If datapoint.HasDataLabel Then
[No clue how to write to Excel]
End If
Next
End Sub
If everything else works ok with the code, this is an easy way to write to the first column of the xlworksheet in excel:
Dim cnt As Long
If datapoint.HasDataLabel Then
cnt = cnt + 1
xlworksheet.Cells(cnt, 1) = datapoint.label
End If
However, I am not sure that after setting xlApp.Visible = True you would be allowed to do something like this Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart.
You had a couple of type errors with your example, but this should get the job done for you. You will need to add a reference to the Microsoft Excel [A Number] Object Library in order to use the Excel object type and all derivatives.
All testing was done using a bar chart.
Sub Extract_Datalabels()
''Goal: To extract datalabels of Chart's series collection and write to excel
Dim datapoint As ChartPoint
Dim chtnow As Chart
Dim xlApp As New Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlworksheet As Excel.Worksheet
Dim Row As Long
Let xlApp.SheetsInNewWorkbook = 1
Set xlWorkbook = xlApp.Workbooks.Add
Set xlworksheet = xlWorkbook.Worksheets(1)
Let xlApp.Visible = True
Call VBA.DoEvents
Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart
Let Row = 1
For Each datapoint In chtnow.SeriesCollection(1).Points
'Extract data labels
If datapoint.HasDataLabel Then
Let xlworksheet.Cells(Row, 1) = datapoint.DataLabel.Text
End If
Let Row = Row + 1
Next
End Sub
Related
I did succeed to export data from a DataGridView to excel file by using a loop and writing cell by cell, but the problem is i have more than 2000 rows so the exporting process takes a lot of time.
My question is : Is there anything to change so i can minimize the exportation time ?
Thanks
'exporter
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
xlApp = New Excel.Application
xlBook = xlApp.Workbooks.Open(Filename:=Path.Combine(Application.StartupPath, "EMP_.xlsx"), IgnoreReadOnlyRecommended:=True, ReadOnly:=False, Editable:=True)
xlSheet = xlBook.Worksheets(1)
If DataGridView1.DataSource IsNot Nothing Then
Dim i, j As Integer
For i = 1 To DataGridView1.RowCount - 1
For j = 1 To DataGridView1.ColumnCount
xlSheet.Cells(i + 1, j) = DataGridView1.Rows(i - 1).Cells(j - 1).Value
Next
Next
xlApp.Visible = True
xlApp.UserControl = True
xlApp.Quit()
xlApp = Nothing
Else
MsgBox("Le tableau est vide")
End If
End Sub
Not sure if this is something might be open too. By chance if you could load your DataGridView via setting the DataSource of the DataGridView to a DataTable then the following would be an option.
Using SpreadSheetLight (installed via NuGet) you can use a function like the sample below. Pass in the following, full path and file name, sheet name, the DataTable from the DataGridView e.g. Dim dt As DataTable = CType(DataGridView1.DataSource,DataTable) and the last argument if True included column headers (DataColumn names) or False exclude column names.
SpreadSheetLight home page.
Public Sub SimpleExportRaw(
pFileName As String,
pSheetName As String,
pDataTable As DataTable,
pColumnHeaders As Boolean)
Using doc As New SLDocument()
doc.SelectWorksheet(pSheetName)
doc.ImportDataTable(1, SLConvert.ToColumnIndex("A"), pDataTable, pColumnHeaders)
doc.SaveAs(pFileName)
End Using
End Sub
I've got a manual for a machine that i need to replace a large amount of part numbers with updated ones (17624 numbers). Ive got an excel doc that ive combiled with row A with old numbers and row B with the new numbers. The manual is in word (2016). Ive tried some code that i found but im unable to get it to work. Ive created a smaller excel doc with only a small list of numbers for testing reasons.
Sub findandreplace()
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim i As Integer, j As Integer
Dim lastRow As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Open("C:\Users\lforget\Downloads\process_batch_folder_addin\list.xlsx")
Set xlWS = xlWB.Worksheets("Sheet1") 'Replace String with your Worksheet Name
lastRow = 1
For i = 1 To ThisDocument.Words.Count - 1 Step 1
For j = 1 To lastRow Step 1
ThisDocument.Words(i) = Replace(ThisDocument.Words(i), xlWS.Cells(j, 1).Value, xlWS.Cells(j, 2).Value)
Next j
Next i
Set xlWS = Nothing
xlWB.Close True
Set xlWB = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
Runtime error 6
ived tried reducing the amount of lines in the excel doc but that hasnt made any difference
A chart was created through the Chart In Microsoft PowerPoint feature and we would like to control how the chart is updated by using a PowerPoint Userform. Is there a line of code that can point to sheet named DVPVreport located within the Chart In Microsoft PowerPoint when the routine is executed? Current code is below which does not consider that the DVPVreport is located within the Chart In Microsoft PowerPoint. We tried to execute code:
Set ws = 'Chart In MicrosoftPowerPoint!'.Worksheets(DVPVreport)
but without success.
Private Sub AddDVSetUp_Click()
Dim ws As Worksheet
Set ws = Worksheets("DVPVreport")
ws.Cells(3, 4).Value = Gate2Date.Value
Unload M
ws.Cells(3, 5).Value = Gate3Date.Value
Unload M
End Sub
Yes it is possible. Try this:
Dim sl As Slide
Set sl = ActivePresentation.Slides(1)
Dim xlWB As Object
Dim sh As Shape, ch As Chart
For Each sh In sl.Shapes
If sh.Type = msoChart Then
Set ch = sh.Chart
Set xlWB = ch.ChartData.Workbook
With xlWB.Sheets(1) '/* It has only 1 sheet so this will be fine */
'/* Do the changes you want here */
.Range("B2").Value = 4.2
End With
End If
Next
Set ch = Nothing: Set xlWB = Nothing: Set sl = Nothing '/* clean up */
Now, if you already know the index or name of your object, you can simply:
Dim sl As Slide
Set sl = ActivePresentation.Slides(1)
Dim xlWB As Object
Dim sh As Shape
Set sh = sl.Shapes("Chart 1")
Set xlWB = sh.Chart.ChartData.Workbook
With xlWB.Sheets(1)
.Range("B2").Value = 4.2
End With
Important: Be very careful not to ruin the source data layout. It de-associates the chart with the ChartData for some reason when you do this.
I have the following code which let me copy
Sub pptCopy()
Dim pptapp As PowerPoint.Application
Dim ppt As PowerPoint.Presentation
Dim slide As PowerPoint.slide
Dim shape1 As PowerPoint.shape
var2 = "C:\Documents and Settings\aa471714\Desktop\Presentation2.pot"
Set pptapp = CreateObject("Powerpoint.Application")
Set ppt = pptapp.Presentations.Open(var2)
Set slide = ppt.Slides(2)
Set shape1 = slide.Shapes.Paste(1)
pptapp.Visible = True
Call copyExcel1
With shape1
.Left = 100
.Width = 100
End With
End Sub
And an another macro
Sub copyExcel1()
Dim oExcel As Excel.Application
Dim oWB As Workbook
Dim cht As Excel.ChartObject
var2 = "C:\Documents and Settings\aa471714\Desktop\Template.xls"
Set oExcel = New Excel.Application
Set oWB = oExcel.Workbooks.Open(var2)
oExcel.Visible = True
Sheets("Sheet5").ChartObjects("AchmeaBankNL").Chart.ChartArea.Copy
End Sub
I however have two issues:
I want to move the excel picture to a specific place in powerpoint (fe shape 3)
I want to copy more than excel figure (i need to copy 2, one to shape 3 and one to shape 4).
Does anybody know how I should edit code below to accomplish this?
Dear regards,
Marc
First, you should edit the subject of your question; it doesn't seem to have anything to do with the question itself.
To move the shape to a specific position in the "stacking" order, use something like this function:
Function ShapeToZOrder(oSh As Shape, lPosition As Long)
oSh.ZOrder msoSendToBack
Do Until oSh.ZOrderPosition = lPosition
oSh.ZOrder msoBringForward
Loop
End Function
i want to export mysql table data with column heading to excel sheet. am using vb.net. but am not able to get table column heading in excel sheet. am getting only mysql table data.
my code
-------
Dim i, j As Integer
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
xlApp = New Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For i = 0 To ds.Tables(0).Rows.Count - 1
For j = 0 To ds.Tables(0).Columns.Count - 1
xlWorkSheet.Cells(i + 1, j + 1) = _
ds.Tables(0).Rows(i).Item(j)
Next
Next
xlWorkSheet.SaveAs("D:\vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()
I don't know Vb.net, but I had a similar issue and had to use the syntax:
IGNORE 1 LINES in the statement.
http://dev.mysql.com/doc/refman/5.1/en/load-data.html (this is for importing, but the IGNORE 1 LINES syntax is described here...)