Создайте заголовок двухстрочной диаграммы и уменьшите размер шрифта во второй строке. - PullRequest
Новая
       46

Создайте заголовок двухстрочной диаграммы и уменьшите размер шрифта во второй строке.

0 голосов
/ 12 апреля 2020

Я хотел бы сгенерировать заголовок из двух линейных диаграмм с использованием VBA, однако я хотел бы, чтобы вторая строка была размером 8, а верхняя линия была больше, скажем, 12 пунктов. Возможно ли это сделать в Excel 2008? 

  Sub CreateChart()
    Dim rng As Range
    Dim cht As Object

    Dim strTitle As String
    strTitle = "CHINA - Currently Infected against  USA, Spain, Germany" & vbCrLf & _
                   "by FRANCK FERRANTE - MegapixelRealestate.com (updated 10-April)"

    Set rng = ActiveSheet.Range("A1:E81")

    Set cht = ActiveSheet.ChartObjects.Add(Top:=120, Left:=550, Width:=460, Height:=260)

    cht.Chart.SetSourceData Source:=rng
    cht.Chart.ChartType = xlColumnClustered
    cht.Chart.HasTitle = True

    With cht.Chart

        .ChartTitle.Text = strTitle
        With .ChartTitle.Characters(1, InStr(strTitle, vbCrLf) - 1)
            .Font.Size = 8
            .Font.Color = vbRed
        End With

        With .ChartTitle.Characters(InStr(strTitle, vbCrLf) + 1, Len(strTitle))
            .Font.Size = 12
            .Font.Color = vbBlue
        End With
    End With

    cht.Chart.ChartGroups(1).GapWidth = 8
    cht.Chart.ChartGroups(1).Overlap = 100
    cht.Chart.ChartTitle.Font.Size = 12


    With cht.Chart.PlotArea.Format.Fill

        .Visible = False
  'add fill color to Plot Area
        .Visible = True
        .Solid

        .ForeColor.RGB = RGB(253, 234, 218)
        .Transparency = 0.6

    End With


    With cht.Chart.ChartArea.Format.Fill

        .Visible = False

        .Visible = True

        .Solid

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0.2

    End With


    With cht.Chart.PlotArea.Select
        Selection.Left = 5
        Selection.Top = 40
        Selection.Width = 400
        Selection.Height = 205

    End With

'move chart to sheet 1

    ActiveSheet.ChartObjects(1).Cut
    Sheets("Sheet1").Select
    Range("F16").Select
    ActiveSheet.Paste

End Sub

Выше приведен код, который требует вашей помощи.

1 Ответ

1 голос
/ 12 апреля 2020

Попробуйте этот кусок кода, пожалуйста: 

Private Sub ChartTitleDifferentLineFont()
 Dim shCh As Chart, strTitle As String
 strTitle = "Test" & vbCrLf & "Title"

 Set shCh = ActiveChart
 With shCh
    .HasTitle = True
    .ChartTitle.Select
    .ChartTitle.text = strTitle
     With .ChartTitle.Characters(1, InStr(strTitle, vbCrLf) - 1)
        .Font.Size = 12
        .Font.Color = vbRed
     End With
    With .ChartTitle.Characters(InStr(strTitle, vbCrLf) + 1, Len(strTitle))
        .Font.Size = 8
        .Font.Color = vbBlue
    End With
 End With
End Sub
...