SeriesCollection(1).Values，"h:mm"格式的数组不成立。

ning84

xChart1.SeriesCollection(1).Values = Rng 单元格成立，数据表中能正确满足需求。
xChart1.SeriesCollection(1).Values = Arr数组不成立，数据表中格式不对，权威零。

1. Sub a2()
   
2.      Dim xChart1 As Chart, xChart2 As Chart
   
3.      Dim Rng As Range
   
4.      Dim Shp As Shape
   
5.      Dim ShpRng As ShapeRange
   
6.      Dim Arr()
   
7.           Set Rng = Sheet1.Range("B2：K2")
   
8.           ReDim Arr(Rng.Columns.Count - 1)
   
9.           For jj = 1 To Rng.Columns.Count
   
10.                Arr(jj - 1) = Rng(, jj)
    
11.           Next jj
    
12.           ii = 1
    
13.           Set xChart1 = Sheet1.Shapes(1).Chart
    
14.           Set xChart2 = Sheet1.Shapes(2).Chart
    
15.          
    
16.           xChart1.SeriesCollection(1).Values = Arr
    
17.           Stop
    
18.           xChart1.SeriesCollection(1).Values = Rng
    
19.           Stop
    
20.           xChart2.SeriesCollection(1).Values = Arr
    
21.          
    
22.           Stop
    
23.           For jj = 1 To Rng.Columns.Count
    
24.                Arr(jj - 1) = Format(Rng(, jj), "h：mm")
    
25.           Next jj
    
26.           xChart2.SeriesCollection(1).Values = Arr
    
27.           Stop
    
28. 
    
29. 
    
30. 
    
31. End Sub

复制代码

493861364

For jj = 1 To Rng.Columns.Count
               Arr(jj - 1) = Format(Rng(, jj), "h：mm")
          Next jj
把Arr格式化成字符串了，图表不会显示字符串的

ning84

493861364 发表于 2023-3-14 15:29
For jj = 1 To Rng.Columns.Count
               Arr(jj - 1) = Format(Rng(, jj), "h：mm")
        ...

谢谢回复,再回顾以前的贴子。
录制宏，没办法更改Microsoft Graph中的表格数据。-Excel VBA程序开发-ExcelHome技术论坛 -  https://club.excelhome.net/thread-1651618-1-1.html
GRAPH.CHART

1. Sub del()
   
2.    Dim DateArr
   
3.       DateArr = Array(0.344143518518518, 0.295590277777778, 0.305763888888889, 0.316655092592593, 0.28744212962963, 0.335081018518519, 0.301400462962963, 0.428032407407407, 0.751655092592593, 0.746076388888889, 0.731851851851852, 0.709282407407407, 0.639097222222222, 0.656782407407407, 0.762569444444444, 0.822488425925926)
   
4. 
   
5. 
   
6.    
   
7.    Dim oChart As Chart
   
8.    Dim objChart As ChartObject
   
9.    Dim Sht As Worksheet
   
10.    Dim Rng As Range
    
11.    Dim Grp As Graph.Application
    
12.    Dim GrpSht As DataSheet
    
13.    Dim GrpChart As Graph.Chart
    
14.    Dim Shp As Shape
    
15.    Dim ShpRng As ShapeRange
    
16.    Dim ii, jj, Ss, Hh
    
17.    
    
18. 
    
19. Arr = Array(-4098, 78, 79, 60, 61, 62, -4100, 54, 55, 56, -4101, -4102, 70, 1, 76, 77, 57, 71, 58, 59, 15, 87, 51, 52, 53, 102, 103, 104, 105, 99, 100, 101, 95, 96, 97, 98, 92, 93, 94, -4120, 80, 4, 65, 66)
    
20.    
    
21.        Set Sht = Sheet2
    
22.        For Each Shp In Sht.Shapes
    
23.             'Debug.Print Shp.Name
    
24.             Shp.Delete
    
25.        Next Shp
    
26.   
    
27.   For ii = 0 To 45 'UBound(Arr)
    
28.        Set GrpChart = Sht.OLEObjects.Add(ClassType:="MSGraph.Chart.8", Link:=False, DisplayAsIcon:=False).Object
    
29.        Set Shp = Sht.Shapes(Sht.Shapes.Count)
    
30.        With Shp
    
31.            '.Width = 1800
    
32.            .Height = 300
    
33.            
    
34.            If ii Mod 2 = 1 Then
    
35.                .Left = 4
    
36.                Hh = (ii + 1) * 160
    
37.            ElseIf ii Mod 2 = 0 Then
    
38.                .Left = 4 + 440
    
39.                Hh = (ii - 0) * 160
    
40.            End If
    
41.            .Top = 4 + Hh
    
42.        End With
    
43.        ''
    
44.        With GrpChart
    
45.             ''
    
46.             Set GrpSht = .Application.DataSheet
    
47.             With GrpSht
    
48.                
    
49.                 For jj = 1 To 8
    
50.                     GrpSht.Cells(1, jj + 1) = "A" & jj
    
51.                 Next jj
    
52.                 ''
    
53.                 For jj = 0 To 7
    
54.                     GrpSht.Cells(2, jj + 2) = Format(DateArr(jj), "hh:mm:ss")
    
55.                     GrpSht.Cells(3, jj + 2) = Format(DateArr(jj + 8), "hh:mm:ss")
    
56.                     Ss = DateArr(jj + 8) - DateArr(jj)
    
57.                     GrpSht.Cells(4, jj + 2) = Format(Ss, "hh:mm:ss")
    
58.                     
    
59.                 Next jj
    
60.                 .Application.Chart.ChartType = Arr(ii)  'xlLineMarkersStacked ' Arr(9)(0)
    
61.                 .Font.Size = 8
    
62.             End With
    
63.             .HasDataTable = True
    
64.             .HasLegend = False
    
65.             .HasAxis(xlCategory, xlPrimary) = True
    
66.             .HasAxis(xlValue, xlPrimary) = False
    
67.             .DataTable.Font.Size = 8
    
68.        End With
    
69.    Next ii
    
70. End Sub
    

复制代码

ning84

Private Sub delPptExcelData()
    Dim Path, Str
    Dim Pres As Presentation
        Path = ThisWorkbook.Path & "\RiseSetModel.pptm"
        Set Pres = OpenPpt(Path)
    Dim Sht As Worksheet
    Dim Rng As Range, oRng As Range, RngArr
        Set oRng = Selection
        Set Sht = oRng.Parent
        For ii = 1 To oRng.Rows.Count
             Set Rng = Sht.Cells(oRng.Row, 2).Resize(, 8)
             RngArr = Traver8Address(Rng)
             '''
             Debug.Print RngArr(1, 1).Areas(1)(1, 0).Address, RngArr(1, 1).Areas(1)(1, 0)
             For ii1 = 1 To UBound(RngArr)
                  Set oRng = RngArr(ii1, 0)
                       Debug.Print oRng.Areas(1),
                  Debug.Print
                  For ii2 = 1 To 2
                      Set oRng = RngArr(ii1, ii2)
                      For jj = 1 To oRng.Areas.Count
                          Debug.Print Format(oRng.Areas(jj), "h:mm:ss"),
                      Next jj
                      Debug.Print
                  Next ii2
             Next ii1
        Next ii
End Sub

Function Traver8Address(Rng As Range)
    '遍历"兰州", "珠海", "武汉", "北京", "抚远", "漠河", "三沙", "喀什"
    Dim Sht As Worksheet
    Dim oRng As Range, oRng1 As Range, oRng2 As Range
    Dim RngArr(1 To 8, 2) As Range
    Dim R As Range, R1 As Range, R2 As Range
    Dim ii, jj, jj1
    Dim Cc, Cc1, Cc2
    Dim Str
   
        Set Sht = Rng.Parent
        Set R = Rng.CurrentRegion
        Set R = Sht.Cells(R(2, 1).Row, 2).Resize(, 8)
        Set R1 = Sht.Cells(Rng.Row, 2).Resize(, 8)
        Set R2 = Sht.Cells(Rng.Row, 2 + 9).Resize(, 8)
        ''
        Cc = 1
        For jj1 = 1 To Rng.Columns.Count
            Str = ""
            Str1 = ""
            Str2 = ""
            For jj = Cc To Rng.Columns.Count
                 Str = Str & R(, jj).Address & ","
                 Str1 = Str1 & R1(, jj).Address & ","
                 Str2 = Str2 & R2(, jj).Address & ","
            Next jj
            ''
            For jj = 1 To Cc - 1
                 Str = Str & R(, jj).Address & ","
                 Str1 = Str1 & R1(, jj).Address & ","
                 Str2 = Str2 & R2(, jj).Address & ","
            Next jj
            Str = Left(Str, Len(Str) - 1)
            Str1 = Left(Str1, Len(Str1) - 1)
            Str2 = Left(Str2, Len(Str2) - 1)
            ''
            Set RngArr(jj1, 0) = Sht.Range(Str)
            Set RngArr(jj1, 1) = Sht.Range(Str1)
            Set RngArr(jj1, 2) = Sht.Range(Str2)
            Cc = Cc + 1
        Next jj1
        ''
        Traver8Address = RngArr
End Function

''打开日出日落模板.
''F:\日出日落时间\RiseSetModel.pptm
Sub PptExcelData()
   
    Dim Path, Str
    Dim oDate As Date
    Dim Pres As Presentation
        Path = ThisWorkbook.Path & "\RiseSetModel.pptm"
        Set Pres = OpenPpt(Path)
    Dim Sht As Worksheet
    Dim Rng As Range, oRng As Range, RngArr
   
        Set oRng = Selection
        Set Sht = oRng.Parent
        For ii = 1 To oRng.Rows.Count
             Set Rng = Sht.Cells(oRng.Row, 2).Resize(, 8)
             RngArr = Traver8Address(Rng)
             '''
             oDate = RngArr(1, 1).Areas(1)(1, 0)
            
             RngToSld oDate, Pres, RngArr
             '''RngArr(1, 1).Areas(1)(1, 0).Address, RngArr(1, 1).Areas(1)(1, 0)
        Next ii
End Sub

Function RngToSld(oDate As Date, Pres As Presentation, RngArr)
   Dim Str
   Dim Sld As Slide, Shp 'As Shape
   Dim xChart 'As Chart
   Dim oTab As Table
   Dim xlWk As Workbook
   
   Dim xSht As Worksheet
   Dim Rng As Range, oRng As Range
   Dim xRng As Range
        ''
        For ii = 1 To UBound(RngArr)
                  Str = RngArr(ii, 0).Areas(1)
                  Set Sld = Pres.Slides(Str)
                  Set xChart = Sld.Shapes("C1").Chart
                  xChart.ChartData.Activate
                  Set xlWk = xChart.ChartData.Workbook
                  Set xSht = xlWk.Worksheets(1)
                  xSht.Cells(15, 1) = oDate
                  Set xRng = xSht.Range("B2:I3")
                  Rng1ToRng2 xRng, RngArr(ii, 1), RngArr(ii, 2)
                  '''
        For ii1 = 16 To 24
            Str = xSht.Cells(ii1, 1)
            Set Shp = Sld.Shapes(Str)
            Set TxtRng = Shp.TextFrame.TextRange
            With TxtRng
                 .Text = xSht.Cells(ii1, 2)
                 .Font.color = -16776961
                 .Characters(xSht.Cells(ii1, 3), xSht.Cells(ii1, 4)).Font.color = 0
            End With
        Next ii1
        ''
        Set oTab = Sld.Shapes("T1").Table
        ExcTab oTab, xSht
                  
                  '''
                  xlWk.Close
        Next ii
End Function
''
Function Rng1ToRng2(Rng As Range, R1, R2)
       For jj = 1 To Rng.Columns.Count
                 Rng(1, jj) = R1.Areas(jj)
                 Rng(2, jj) = R2.Areas(jj)
       Next jj
End Function
'''
Function ExcTab(oTab As Table, Sht As Worksheet)
      Dim Str
      Dim Cc1 As Integer, Cc2 As Integer
             With oTab
                  
                  For ii = 1 To 3
                     .Rows(ii).Height = 25
                  Next ii
                  For jj = 3 To 9
                       .Cell(1, jj - 2).Shape.TextFrame2.TextRange.Text = Sht.Cells(1, jj) & "-" & Sht.Cells(1, 2)
                  Next jj
                  ''
                  For ii = 2 To 5
                     For jj = 3 To 9
                        'Nn = Sht.Cells(ii, jj) - Sht.Cells(ii, 2)
                        'Str = Format(Abs(Nn), "h""时""m""分"";@")
                        Str = Format(Abs(Sht.Cells(ii, jj) - Sht.Cells(ii, 2)), "h:m")
                        Nn = Split(Str, ":")
                        Str = Nn(0) * 60 + Nn(1) & "分"
                        Cc2 = Len(Str)
                        'Debug.Print Str, Cc2
                        Select Case ii
                            Case 2, 3
                                   .Cell(ii, jj - 2).Shape.TextFrame2.TextRange.Text = Sht.Cells(ii, 1) & "时差" & Str & _
                                       vbCr & "(" & Format(Sht.Cells(ii, jj), "h:mm") & "-" & Format(Sht.Cells(ii, 2), "h:mm") & "=" & Format(Abs(Sht.Cells(ii, jj) - Sht.Cells(ii, 2)), "h:mm") & ")"
                                   
                                   With .Cell(ii, jj - 2).Shape.TextFrame.TextRange.Characters(5, Cc2)
                                        .Font.color = -16776961
                                        .Font.Size = 20
                                   End With
                        End Select
                        
                     Next jj
                  Next ii
             End With
End Function