从Microsoft Graph中提取数据

vegas-chang · 发表于 2014-11-24 12:14

见附件中Excel表，内含有一个Microsoft Graph对象图表，双击后可以显示图表的源数据。
因为想对源数据进行一些分析处理，如何使用VBA提取源数据？谢谢！

lee1892 · 发表于 2014-11-24 12:24

太诡异了，在Excel里OLE一个Graph对象~

vegas-chang · 发表于 2014-11-24 12:30

lee1892 发表于 2014-11-24 12:24
太诡异了，在Excel里OLE一个Graph对象~

这个是我们检测设备制造商搞进去的。其实还有最原始的txt原始数据，但没有经过预处理，数据预处理太麻烦。我想直接调用这里面处理过的数据

vegas-chang · 发表于 2014-11-24 14:17

vegas-chang 发表于 2014-11-24 12:30
这个是我们检测设备制造商搞进去的。其实还有最原始的txt原始数据，但没有经过预处理，数据预处理太麻烦。 ...

原始数据处理比较麻烦了。想取个巧，直接调用不更好么

lee1892 · 发表于 2014-11-25 09:31

本帖最后由 lee1892 于 2014-11-25 10:15 编辑

貌似Graph对象的数据确定行列的最大值没啥好办法呀

Sub GetGraphData()
Dim aData, i&, j&, nRows&, nCols&
With Worksheets(1).OLEObjects(1).Object.Application.DataSheet
Do
If IsEmpty(.Cells(nRows + 1, 1)) Then Exit Do
nRows = nRows + 1
Loop
Do
If IsEmpty(.Cells(1, nCols + 1)) Then Exit Do
nCols = nCols + 1
Loop
ReDim aData(1 To nCols, 1 To nRows)
For i = 1 To nRows
For j = 1 To nCols
If .Cells(i, j) <> "NaN" Then aData(j, i) = .Cells(i, j)
Next
Next
End With
Worksheets(1).Range("A24").Resize(nCols, nRows) = aData
Erase aData
End Sub

复制代码

德语的系统？

vegas-chang · 发表于 2014-11-25 11:54

lee1892 发表于 2014-11-25 09:31
貌似Graph对象的数据确定行列的最大值没啥好办法呀德语的系统？

设备开发商是德国的。

vegas-chang · 发表于 2014-11-25 11:57

lee1892 发表于 2014-11-25 09:31
貌似Graph对象的数据确定行列的最大值没啥好办法呀德语的系统？

谢谢！好好琢磨琢磨

ning84 · 发表于 2023-1-20 12:37

Sub DEL()
Dim Sht As Worksheet, Sht1 As DataTable
Set Sht = Worksheets(1)
Debug.Print Sht.Name
Dim Ole As OLEObject
Set Ole = Sht.OLEObjects(1)
Sht.OLEObjects(1).Verb
Debug.Print Ole.Name
With Worksheets(1).OLEObjects(1).Object.Application.DataSheet
.Cells(1, 1) = 1111111
End With
Sht.OLEObjects(1).Object.Application.DataSheet.Cells(2, 1) = 777777
Stop
Stop
End Sub

复制代码

有点眉目，离目标越来越近了。
   With Worksheets(1).OLEObjects(1).Object.Application.DataSheet
         .Cells(1, 1) = 1111111
   End With
   Sht.OLEObjects(1).Object.Application.DataSheet.Cells(2, 1) = 777777

ning84 · 发表于 2023-1-21 07:31

ppt方法

Sub L1()
Dim Pres As Presentation
Dim Sld As Slide
Dim Shp As Shape
Dim a
Dim ShpRng As ShapeRange
Set Pres = Application.ActivePresentation
For Each Sld In Pres.Slides
Debug.Print Sld.Name
For Each Shp In Sld.Shapes
Debug.Print Shp.Name, Shp.OLEFormat.Object.Application.Name
Shp.Select msoCTrue
Shp.OLEFormat.Object.Application.DataSheet.Cells(2, 2) = 2
Next Shp
Next Sld
End Sub

复制代码

ning84 · 发表于 2023-1-21 18:41

Sub L1()
Dim oPresent As Presentation
Dim Sld As Slide
Dim Shp As Shape
''
Dim Grp As Graph.Chart
Dim gSht As Graph.DataSheet
Dim gRng As Graph.Range, gRng2 As Graph.Range
''
Dim Obj 'As CellRange
Dim Sht As Worksheet
Dim ShpRng As ShapeRange
Dim Path, xlPathName, xlName As String
Dim xlWk As Excel.Workbook
Dim Rng As Excel.Range, Rng1 As Excel.Range, Rng2 As Excel.Range
xlName = "\del.xls"
Set oPresent = Application.ActivePresentation
Path = oPresent.Application.ActivePresentation.Path
Set xlWk = PptSetWk("\中国东西南北城市.xls")
For Each Sht In xlWk.Sheets
Debug.Print Sht.Name
Next Sht
Set Sht = xlWk.Sheets("图表数据")
Debug.Print Sht.Cells(1, 1).Formula
Debug.Print Sht.Cells(1, 1).Formula, Sht.Cells(2, 1).Formula, Sht.Cells(1, 2).Formula
Stop
Stop
For Each Sld In oPresent.Slides
For Each Shp In Sld.Shapes
Set Grp = Shp.OLEFormat.Object
Debug.Print Shp.Name, DataSheetDataSheet; Shp.OLEFormat.Object.Application.Name
With Grp
Debug.Print .Name, .Application.Name,
Debug.Print .ChartType
End With
Set gSht = Shp.OLEFormat.Object.Application.DataSheet
Set gRng2 = gSht.Cells(2, 2)
Stop
Next Shp
Next Sld
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 从Microsoft Graph中提取数据

点评