北京工业大学开题报告模板VBA编程

Sub Reference_Chnange()
    Dim startRange As Range
    Dim endRange As Range
    Dim contentRange As Range
    
    ' 查找"参考文献"的位置
    Set startRange = ActiveDocument.Content
    startRange.Find.Execute FindText:="参考文献"
    
    ' 查找"end"的位置
    Set endRange = ActiveDocument.Content
    endRange.Find.Execute FindText:="end", Forward:=False
    
    ' 确保找到了"参考文献"和"end"
    If startRange.Find.Found And endRange.Find.Found Then
        ' 设置中间内容的范围
        Set contentRange = ActiveDocument.Range(startRange.End, endRange.Start)
        
        ' 设置段落的悬挂缩进为2字符
        contentRange.ParagraphFormat.LeftIndent = CentimetersToPoints(0.63)
        contentRange.ParagraphFormat.FirstLineIndent = CentimetersToPoints(-0.63)
    End If
End Sub

Sub Titile_Change_KaiTi()
'
' Titile_Change 宏
'
 Dim heading As Paragraph
'' 设置一级标题
' 设置一级标题
For Each heading In ActiveDocument.Paragraphs
    If heading.Style = "标题 1" Then
        With heading.Range
            .Style = ActiveDocument.Styles("标题 1")
            .ParagraphFormat.Alignment = wdAlignParagraphLeft
            .Font.Size = 18
            .Font.Bold = True
            .Font.Name = "宋体"
            .Font.Name = "Times New Roman"
            .ParagraphFormat.Alignment = wdAlignParagraphCenter
            .ParagraphFormat.SpaceAfter = 0.5 * .Font.Size
            .ParagraphFormat.SpaceBefore = 0
        End With
        With heading.Range.ParagraphFormat
            .SpaceBefore = 0
            .SpaceAfter = 0
        End With
    End If
Next heading

' 设置二级标题
For Each heading In ActiveDocument.Paragraphs
    If heading.Style = "标题 2" Then
        With heading.Range
            .Style = ActiveDocument.Styles("标题 2")
            .ParagraphFormat.Alignment = wdAlignParagraphLeft
            .Font.Size = 16
            .Font.Bold = True
            .Font.Name = "宋体"
            .Font.Name = "Times New Roman"
            .ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
            .ParagraphFormat.SpaceAfter = 0.5 * .Font.Size
            .ParagraphFormat.SpaceBefore = 0
        End With
        With heading.Range.ParagraphFormat
            .SpaceBefore = 0
            .SpaceAfter = 0
        End With
    End If
Next heading
' 设置三级标题
For Each heading In ActiveDocument.Paragraphs
    If heading.Style = "标题 3" Then
        With heading.Range
            .Style = ActiveDocument.Styles("标题 3")
            .ParagraphFormat.Alignment = wdAlignParagraphLeft
            .Font.Size = 15
            .Font.Bold = True
            .Font.Name = "宋体"
            .Font.Name = "Times New Roman"
            .ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
            .ParagraphFormat.SpaceAfter = 0.5 * .Font.Size
            .ParagraphFormat.SpaceBefore = 0
        End With
        With heading.Range.ParagraphFormat
            .SpaceBefore = 0
            .SpaceAfter = 0
        End With
    End If
Next heading

' 设置四级标题
For Each heading In ActiveDocument.Paragraphs
    If heading.Style = "标题 4" Then
        With heading.Range
            .Style = ActiveDocument.Styles("标题 4")
            .ParagraphFormat.Alignment = wdAlignParagraphLeft
            .Font.Size = 14
            .Font.Bold = True
            .Font.Name = "宋体"
            .Font.Name = "Times New Roman"
            .ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
            .ParagraphFormat.SpaceAfter = 0.5 * .Font.Size
            .ParagraphFormat.SpaceBefore = 0
        End With
        With heading.Range.ParagraphFormat
            .SpaceBefore = 0
            .SpaceAfter = 0
        End With
    End If
Next heading
    
End Sub

Sub Body_Kaiti()
    Dim doc As Document
    Set doc = ActiveDocument
    
    ' 设置正文样式
    With doc.Styles(wdStyleNormal).Font
        .Name = "宋体"
        .Name = "Times New Roman"
        .Size = 10
    End With
    
    With doc.Styles(wdStyleNormal).ParagraphFormat
        .LeftIndent = Application.CentimetersToPoints(0.74) ' 首行缩进两字符
        .LineSpacingRule = wdLineSpaceSingle ' 单倍行距
        .LeftIndent = 0 ' 左侧缩进为0
        .RightIndent = 0 ' 右侧缩进为0
    End With
End Sub

Sub Formula2Internal()
'
' Formula2Internal 宏
'
'
    Dim doc As Document
    Set doc = ActiveDocument
    
    ' 获取所选内容
    Dim selectedRange As Range
    Set selectedRange = Selection.Range
    
    ' 获取页面设置对象
    Dim pageSetup As pageSetup
    Set pageSetup = doc.pageSetup
    
    ' 获取页边距和页面宽度
    Dim leftMargin As Single
    Dim rightMargin As Single
    Dim pageWidth As Single
    
    leftMargin = pageSetup.leftMargin
    rightMargin = pageSetup.rightMargin
    pageWidth = pageSetup.pageWidth
    
    ' 计算居中对齐的制表位位置
    Dim centerTabPosition As Single
    centerTabPosition = (pageWidth - leftMargin - rightMargin) / 2
    
    ' 添加居中对齐的制表位
    selectedRange.ParagraphFormat.TabStops.Add Position:=centerTabPosition, Alignment:=wdAlignTabCenter
    
    ' 添加右对齐的制表位
    selectedRange.ParagraphFormat.TabStops.Add Position:=pageWidth - rightMargin - leftMargin, Alignment:=wdAlignTabRight
End Sub

Sub Images2Internal()
    Dim pic As InlineShape
    Dim totalWidth As Single
    Dim spacing As Single
    Dim tabWidth As Single
    
    
    ' 设置图片高度和间距
    Dim newHeight As Integer
    newHeight = 100 ' 设置图片高度为200磅
    
    ' 计算总宽度和制表位宽度
    For Each pic In Selection.InlineShapes
        totalWidth = totalWidth + pic.Width
    Next pic
    tabWidth = (Selection.pageSetup.pageWidth - Selection.pageSetup.rightMargin - Selection.pageSetup.leftMargin - totalWidth) / (Selection.InlineShapes.Count + 1)
    
    ' 调整图片大小和位置
    Dim leftPosition As Single
    leftPosition = tabWidth
    
    For Each pic In Selection.InlineShapes
        ' 锁定图片比例
        pic.LockAspectRatio = msoTrue
        
        ' 调整图片大小
        pic.Height = newHeight
        
        ' 设置图片位置
        'pic.Range.ParagraphFormat.TabStops.Add Position:=leftPosition, Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
        leftPosition = leftPosition + pic.Width + tabWidth
        midPosition = leftPosition - pic.Width / 2 - tabWidth

        pic.Range.ParagraphFormat.TabStops.Add Position:=midPosition, Alignment:=wdAlignTabCenter, Leader:=wdTabLeaderSpaces
    Next pic
End Sub