VBA代码：创建图表并保存为BMP格式，并插入Word文档

Sub CreateChartSaveAsBMP()
    Dim MyChart As ChartObject
    Dim MyXValues1 As Range
    Dim MyYValues1 As Range
    Dim MyXValues2 As Range
    Dim MyYValues2 As Range
    Dim MyXValues3 As Range
    Dim MyYValues3 As Range
    Dim ChartTitle As String
    Dim SeriesName1 As String
    Dim SeriesName2 As String
    Dim SeriesName3 As String
    Dim FilePath As String
    Dim m, n, i As Long
    Dim FolderPath As String
    Dim picFolderPath As String
    Dim picFile As String
    Dim wspro As Worksheet
    Dim wdApp As Object ' Word.Application
    Dim wdDoc As Object ' Word.Document
    Dim wdShape As Object ' Word.InlineShape
    
    Set wspro = ThisWorkbook.Sheets("DataPro")
    FolderPath = ThisWorkbook.Path
    picFolderPath = FolderPath & "\pic"

    ' 创建保存Word文件的pic文件夹
    If Dir(picFolderPath, vbDirectory) = "" Then
        MkDir picFolderPath
    Else
        picFile = Dir(picFolderPath & "\*.*")
        Do While picFile <> ""
            Kill picFolderPath & "\" & picFile
            picFile = Dir
        Loop
    End If

    m = wspro.UsedRange.Rows.Count
    n = wspro.UsedRange.Columns.Count

    ' 创建并打开新的Word文档
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add

    For i = 3 To n Step 3
        Set MyXValues1 = wspro.Range(wspro.Cells(4, 1), wspro.Cells(m, 1))
        Set MyYValues1 = wspro.Range(wspro.Cells(4, i - 1), wspro.Cells(m, i - 1))
        
        Set MyXValues2 = wspro.Range(wspro.Cells(4, 1), wspro.Cells(m, 1))
        Set MyYValues2 = wspro.Range(wspro.Cells(4, i), wspro.Cells(m, i))
        
        Set MyXValues3 = wspro.Range(wspro.Cells(4, 1), wspro.Cells(m, 1))
        Set MyYValues3 = wspro.Range(wspro.Cells(4, i + 1), wspro.Cells(m, i + 1))
        
        ChartTitle = wspro.Cells(1, i).Value
        SeriesName1 = wspro.Cells(3, i - 1).Value
        SeriesName2 = wspro.Cells(3, i).Value
        SeriesName3 = wspro.Cells(3, i + 1).Value

        Set MyChart = wspro.ChartObjects.Add(Left:=100, Width:=600, Top:=75, Height:=360)
        MyChart.Chart.ChartType = xlLine

        With MyChart.Chart.SeriesCollection.NewSeries
            .XValues = MyXValues1
            .Values = MyYValues1
            .Name = SeriesName1
            .Format.Line.DashStyle = msoLineSolid
            .Format.Line.Weight = 1.5
        End With

        With MyChart.Chart.SeriesCollection.NewSeries
            .XValues = MyXValues2
            .Values = MyYValues2
            .Name = SeriesName2
            .Format.Line.DashStyle = msoLineSysDot
            .Format.Line.Weight = 2
        End With

        With MyChart.Chart.SeriesCollection.NewSeries
            .XValues = MyXValues3
            .Values = MyYValues3
            .Name = SeriesName3
            .Format.Line.DashStyle = msoLineSysDash
            .Format.Line.Weight = 2.5
        End With

        MyChart.Chart.HasTitle = True
        MyChart.Chart.ChartTitle.Text = ChartTitle

        MyChart.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
        MyChart.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "转速（r/min）"

        MyChart.Chart.Axes(xlValue, xlPrimary).HasTitle = True
        MyChart.Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "响应值（mm/s）"

        MyChart.Chart.Axes(xlCategory).CategoryType = xlAutomatic
        MyChart.Chart.Axes(xlCategory).CategoryType = xlCategoryScale
        MyChart.Chart.Axes(xlCategory).TickLabelSpacing = 5

        FilePath = picFolderPath & "\" & ChartTitle & ".bmp"
        MyChart.Chart.Export Filename:=FilePath, FilterName:="BMP"
        
        ' 将图片插入到Word文档中并居中显示
        Set wdShape = wdDoc.Shapes.AddPicture(FilePath, False, True)
        With wdShape
            .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Left = wdApp.CentimetersToPoints(2.54) ' 2.54 cm
            .Top = wdApp.CentimetersToPoints(2.54) ' 2.54 cm
            .Width = wdApp.CentimetersToPoints(15.24) ' 15.24 cm
            .Height = wdApp.CentimetersToPoints(9.6) ' 9.6 cm
        End With
        
        MyChart.Delete
    Next i
    
    ' 保存并关闭Word文档
    wdDoc.SaveAs picFolderPath & "\vib.docx"
    wdDoc.Close
    wdApp.Quit
    
    Set wdShape = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing
End Sub

这样修改后的代码会将Word文件保存在与BMP文件相同的pic文件夹中，并且只会插入包含折线的BMP图片到Word文档中。Word文件将被命名为"vib.docx"。请确保你已经安装了Microsoft Word，并且VBA引用了Word对象库（在VBA编辑器中选择"工具"->"引用"，并勾选"Microsoft Word xx.x Object Library"）。