mod1.bas

自动排版程序

Attribute VB_Name = "Module1"
Option Explicit


Public strTitles() As String
Public strSource() As String
Public strContents() As String
Public strClass() As String

Public intT As Integer
Public intS As Integer
Public intC As Integer
Public intCl As Integer




Public Sub AddList(parTitle As String, parSource As String, parContent As String, parClass As String)

ReDim Preserve strTitles(intT) As String
ReDim Preserve strSource(intS) As String
ReDim Preserve strContents(intC) As String
ReDim Preserve strClass(intCl) As String
   strTitles(intT) = parTitle
   strSource(intT) = parSource
   strContents(intC) = parContent
   strClass(intCl) = parClass
       
   Form1.lstTitles.AddItem strTitles(intT) & "----" & strClass(intT), intT
   
   intT = intT + 1
   intS = intS + 1
   intC = intC + 1
   intCl = intCl + 1
End Sub

Public Sub OutWord(NoHZ As String, NoSum As String, PubYear As String, PubMonth As String, PubDay As String)

    Dim MyWord As Word.Application
    Dim MyDocument As Word.Document
    
    Dim MyRange As Word.Range
    Dim MySelect As Word.Selection
    
    Dim i As Integer
    Dim j As Integer
    Dim BtLen As Integer
    Dim strBT As String
    Dim strXX As String
On Error Resume Next
Set MyWord = GetObject(, "Word.Application")
Set MyWord = CreateObject("Word.Application")
'    If Not MyWord Then Set MyWord = CreateObject("Word.Application")
    Set MyDocument = MyWord.Documents.Add
    Set MyRange = MyDocument.Range(Start:=0, End:=0)
    
    
    
'****************************输入报头***************************************
    MyRange.Paragraphs.Alignment = wdAlignParagraphCenter     '居中
    MyRange.InsertAfter Chr(13) & "情 况 反 映" & Chr(13)
    MyRange.Font.Name = "隶书"
    MyRange.Font.Size = 42
    MyRange.Font.Bold = True
    MyRange.Font.ColorIndex = wdRed
    
    MyRange.Start = MyRange.End
    MyRange.InsertAfter "第" & NoHZ & "期" & Chr(13)
    MyRange.Font.Name = "楷体_GB2312"
    MyRange.Font.Size = 16
    MyRange.Font.Bold = True
    MyRange.Font.ColorIndex = wdRed
    
    MyRange.Start = MyRange.End
    MyRange.InsertAfter "一汽驻京办事处       总第" & CStr(NoSum) & "期     " & _
                        CStr(PubYear) & "年" & CStr(PubMonth) & "月" & CStr(PubDay) & "日" & Chr(13)
    MyRange.Font.Name = "楷体_GB2312"
    MyRange.Font.Size = 16
    MyRange.Font.Bold = True
    MyRange.Font.Underline = wdUnderlineDouble    '双下划线
    MyRange.Font.ColorIndex = wdRed
    
    MyRange.Start = MyRange.End
    MyRange.InsertAfter "（内部资料  注意保管）"
    MyRange.Font.Name = "楷体_GB2312"
    MyRange.Font.Bold = True
    MyRange.Font.Size = 14
    
    MyRange.Start = MyRange.End
    MyRange.InsertAfter Chr(13) & Chr(13) & "目     录" & Chr(13)
    MyRange.Font.Name = "黑体"
    MyRange.Font.Size = 16
    MyRange.Font.Bold = True
    
    MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
    MyRange.ParagraphFormat.LineSpacing = 26
    
    MyDocument.Activate
    MyWord.Visible = True
    
'*************************宏观动向目录******************8
    MyRange.Start = MyRange.End
    MyRange.InsertAfter "宏观动向" & Chr(13)
    MyRange.Font.Name = "隶书"
    MyRange.Font.Size = 14
    MyRange.Font.Bold = True
    MyRange.Font.ColorIndex = wdBlue
    
    MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
    
    MyRange.Start = MyRange.End
    For i = 0 To intT - 1
        If strClass(i) = "宏观动向" Then
            
            strBT = strTitles(i)
            BtLen = Len(strBT)
            MyRange.InsertAfter "    " & strBT
            MyRange.Font.Name = "楷体_GB2312"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft

            For j = 1 To 90 - (3 * BtLen + 10)
                MyRange.InsertAfter "-"
            Next j
            MyRange.InsertAfter Chr(13)
            MyRange.Font.Name = "Times New Roman"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
        End If
        MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        MyRange.ParagraphFormat.LineSpacing = 18
        
        MyWord.ScreenRefresh
    Next i
    
'******************************行业动向的目录*************************8

    MyRange.Start = MyRange.End
    MyRange.InsertAfter "行业动向" & Chr(13)
    MyRange.Font.Name = "隶书"
    MyRange.Font.Size = 14
    MyRange.Font.Bold = True
    MyRange.Font.ColorIndex = wdBlue
    
    MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
    
    MyRange.Start = MyRange.End
'    MyRange.InsertAfter "   企业纵横" & Chr(13)
'    MyRange.Font.Name = "隶书"
'    MyRange.Font.Size = 14
'    MyRange.Font.Italic = True
'    MyRange.Font.ColorIndex = wdBlack
    
'    MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
'    MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
'    MyRange.ParagraphFormat.LineSpacing = 18
'    MyRange.Start = MyRange.End
'
'    Dim gnName(4) As String
'    gnName(1) = "重要企业"
'    gnName(2) = "一般企业"
'    gnName(3) = "市场动态"
'    gnName(4) = "综合报道"
'        For i = 1 To 4
'            strBT = gnName(i)
'            BtLen = Len(strBT)
'            MyRange.InsertAfter "    " & strBT
'            MyRange.Font.Name = "楷体_GB2312"
'            MyRange.Font.Size = 14
'            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
'            For j = 1 To 90 - (3 * BtLen + 10)
'                MyRange.InsertAfter "-"
'            Next j
'            MyRange.InsertAfter Chr(13)
'            MyRange.Font.Name = "Times New Roman"
'            MyRange.Font.Size = 14
'            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
'        Next i
'    MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
'    MyRange.ParagraphFormat.LineSpacing = 18
'    MyRange.Start = MyRange.End
'
'    MyRange.InsertAfter "   国际采撷" & Chr(13)
'    MyRange.Font.Name = "隶书"
'    MyRange.Font.Size = 14
'    MyRange.Font.Italic = True
'    MyRange.Font.ColorIndex = wdBlack
'
'    MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
'
'    MyRange.Start = MyRange.End
    Dim gjName(3) As String
    gjName(1) = "企业纵横"
    gjName(2) = "市场动态"
    gjName(3) = "综合报道"

        For i = 1 To 3
            strBT = gjName(i)
            BtLen = Len(strBT)
            MyRange.InsertAfter "    " & strBT
            MyRange.Font.Name = "楷体_GB2312"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
            For j = 1 To 90 - (3 * BtLen + 10)
                MyRange.InsertAfter "-"
            Next j
            MyRange.InsertAfter Chr(13)
            MyRange.Font.Name = "Times New Roman"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
        Next i
        
        MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        MyRange.ParagraphFormat.LineSpacing = 18
        
        MyWord.ScreenRefresh
    
    
    
     
' '***********************综信采撷的目录*******************
    MyRange.Start = MyRange.End
    MyRange.InsertAfter "综信采撷" & Chr(13)
    MyRange.Font.Name = "隶书"
    MyRange.Font.Size = 14
    MyRange.Font.Bold = True
    MyRange.Font.ColorIndex = wdBlue
    
    MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
    
    MyRange.Start = MyRange.End
    For i = 0 To intT - 1
        If strClass(i) = "综信采撷" Then
            
            strBT = strTitles(i)
            BtLen = Len(strBT)
            MyRange.InsertAfter "    " & strBT
            MyRange.Font.Name = "楷体_GB2312"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft

            For j = 1 To 90 - (3 * BtLen + 10)
                MyRange.InsertAfter "-"
            Next j
            MyRange.InsertAfter Chr(13)
            MyRange.Font.Name = "Times New Roman"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
        End If
        MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        MyRange.ParagraphFormat.LineSpacing = 18
        
        MyWord.ScreenRefresh
    Next i
     
     

 
'**********************************************************************************************************************
     MyRange.Collapse direction:=wdCollapseEnd
     MyRange.InsertBreak wdPageBreak
     
'*************************宏观动向的内容******************8
   '加框的标头
    MyRange.InsertAfter Chr(13)
    
    MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
    MyRange.ParagraphFormat.LineSpacing = 26
    MyRange.Start = MyRange.End
    
    MyRange.InsertAfter "宏观动向"
    MyRange.Font.Name = "隶书"
    MyRange.Font.Size = 14
    MyRange.Font.Bold = True
    MyRange.Font.ColorIndex = wdBlue
    MyRange.Select
    MyRange.Borders.OutsideLineStyle = wdLineStyleDouble '###############
    MyRange.Borders.OutsideColorIndex = wdViolet
    MyRange.Borders.OutsideLineWidth = wdLineWidth050pt
    MyRange.Paragraphs.Alignment = wdAlignParagraphLeft

    MyRange.InsertAfter Chr(13)
    MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
    MyRange.ParagraphFormat.LineSpacing = 26

   '内容
    For i = 0 To intT - 1
        If strClass(i) = "宏观动向" Then
            MyRange.Start = MyRange.End
            strBT = strTitles(i)
            MyRange.InsertAfter strBT & Chr(13)
            MyRange.Font.Name = "黑体"
            MyRange.Font.Size = 14
            MyRange.Font.Bold = True
            MyRange.Paragraphs.Alignment = wdAlignParagraphCenter
        MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        MyRange.ParagraphFormat.LineSpacing = 26
    
            
            MyRange.Start = MyRange.End
            strXX = strContents(i)
            MyRange.InsertAfter "    " & Trim(strXX) & "     " & Trim(strSource(i)) & Chr(13)
            MyRange.Font.Name = "仿宋_GB2312"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphJustify    '两端对齐
            
           
        End If
        MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        MyRange.ParagraphFormat.LineSpacing = 26
    DoEvents
    Next i

'***********************行业动向的报头******************************
    MyRange.InsertAfter Chr(13)
        MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        MyRange.ParagraphFormat.LineSpacing = 26
        MyRange.Start = MyRange.End

    MyRange.Start = MyRange.End
    MyRange.InsertAfter "行业动向"
    MyRange.Font.Name = "隶书"
    MyRange.Font.Size = 14
    MyRange.Font.Bold = True
    MyRange.Font.ColorIndex = wdBlue
    MyRange.Select
    MyRange.Borders.OutsideLineStyle = wdLineStyleDouble '###############
    MyRange.Borders.OutsideColorIndex = wdViolet
    MyRange.Borders.OutsideLineWidth = wdLineWidth050pt
    MyRange.Paragraphs.Alignment = wdAlignParagraphLeft

    MyRange.InsertAfter Chr(13)
    MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
    MyRange.ParagraphFormat.LineSpacing = 26

'************************国内纵横*****************
'    MyRange.Start = MyRange.End
'    MyRange.InsertAfter "   国内纵横" & Chr(13)
'    MyRange.Font.Name = "隶书"
'    MyRange.Font.Size = 14
'    MyRange.Font.Italic = True
'    MyRange.Font.ColorIndex = wdBlack
'
'    MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
'    MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
 '   MyRange.ParagraphFormat.LineSpacing = 18
'    MyRange.Start = MyRange.End
'****************************企业纵横的内容***********************
    
            MyRange.Start = MyRange.End
            MyRange.InsertAfter "企  业  纵  横" & Chr(13)
            MyRange.Font.Name = "黑体"
            MyRange.Font.Size = 14
            MyRange.Font.Bold = True
            MyRange.Paragraphs.Alignment = wdAlignParagraphCenter

        MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        MyRange.ParagraphFormat.LineSpacing = 26
        MyRange.Start = MyRange.End

    For i = 0 To intT - 1
        If strClass(i) = "企业纵横" Then
            MyRange.Start = MyRange.End
            MyRange.InsertAfter "※"
            MyRange.Font.Name = "仿宋_GB2312"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
        
            MyRange.Start = MyRange.End
            strXX = strContents(i)
            MyRange.InsertAfter " " & Trim(strXX) & "    " & Trim(strSource(i)) & Chr(13)
            MyRange.Font.Name = "仿宋_GB2312"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphJustify
       '建立悬挂缩进
            MyRange.ParagraphFormat.FirstLineIndent = InchesToPoints(-0.3)
            MyRange.ParagraphFormat.LeftIndent = InchesToPoints(0.3)
                   
            MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
            MyRange.ParagraphFormat.LineSpacing = 26

         End If
    DoEvents
    Next i
            
            
'***************************市场动态的内容***********************

            MyRange.Start = MyRange.End
            MyRange.InsertAfter "市  场  动  态" & Chr(13)
            MyRange.Font.Name = "黑体"
            MyRange.Font.Size = 14
            MyRange.Font.Bold = True
            MyRange.Paragraphs.Alignment = wdAlignParagraphCenter
        MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        MyRange.ParagraphFormat.LineSpacing = 26
        MyRange.Start = MyRange.End

    
    For i = 0 To intT - 1
        If strClass(i) = "市场动态" Then
            MyRange.Start = MyRange.End
            MyRange.InsertAfter "※"
            MyRange.Font.Name = "仿宋_GB2312"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphLeft
        
            MyRange.Start = MyRange.End
            strXX = strContents(i)
            MyRange.InsertAfter " " & Trim(strXX) & "     " & Trim(strSource(i)) & Chr(13)
            MyRange.Font.Name = "仿宋_GB2312"
            MyRange.Font.Size = 14
            MyRange.Paragraphs.Alignment = wdAlignParagraphJustify
       '建立悬挂缩进
            MyRange.ParagraphFormat.FirstLineIndent = InchesToPoints(-0.3)
            MyRange.ParagraphFormat.LeftIndent = InchesToPoints(0.3)
                   
            MyRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
            MyRange.ParagraphFormat.LineSpacing = 26

         End If
    DoEvents
    Next i
'***************************市场动态的内容***********************
'
'           MyRange.Start = MyRange.End