VBA/Excel/Access/Word/Word/Word Document

Материал из VB Эксперт
Перейти к: навигация, поиск

Add a word document

 
Sub wordDoc()
    Dim WordApp As Object
    Set WordApp = CreateObject("Word.Application")
    With WordApp
        .Documents.Add
    End With
End Sub



Close a document

 
Sub exitFor()
    Dim Doc As Document
    For Each Doc In Documents
        If Doc.Name = "Document1" Then Exit For
        Doc.Close
    Next Doc
End Sub



Generating Word ata from an Excel VBA program

 
Sub MakeMemos()
    Dim WordApp As Object
    Set WordApp = CreateObject("Word.Application")
    
    For i = 1 To 3
        Application.StatusBar = "Processing Record " & i
        SaveAsName = ThisWorkbook.Path & "\test.doc"
        With WordApp
            .Documents.Add
            With .Selection
                .Font.Size = 14
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
                .TypeText Text:="M E M O R A N D U M"
                .TypeParagraph
                .TypeParagraph
                .Font.Size = 12
                .ParagraphFormat.Alignment = 0
                .Font.Bold = False
                .TypeText Text:="Date:" & vbTab & Format(Date, "mmmm d, yyyy")
                .TypeParagraph
                .TypeText Text:="To:" & vbTab & " Manager"
                .TypeParagraph
                .TypeText Text:="From:" & vbTab & _
                   Application.userName
                .TypeParagraph
                .TypeParagraph
                .TypeText "text"
                .TypeParagraph
                .TypeParagraph
                .TypeText Text:="Units Sold:" & vbTab & "asdf"
                .TypeParagraph
                .TypeText Text:="Amount:" & vbTab & Format(1000, "$#,##0")
            End With
                .ActiveDocument.SaveAs FileName:=SaveAsName
                .ActiveWindow.Close
        End With
    Next i
    WordApp.Quit
    Set WordApp = Nothing
    Application.StatusBar = ""
    MsgBox " memos were created and saved in " & ThisWorkbook.Path
End Sub



Load contact table from Access and create letter in Word

 
Sub ControlWord()
    Dim objWord As New Word.Application
    Dim rsContacts As New ADODB.Recordset
    Dim strLtrContent As String
    rsContacts.ActiveConnection = CurrentProject.Connection
    rsContacts.Open "tblContacts"
    
    objWord.Documents.Add
    
    Do While Not rsContacts.EOF
      strLtrContent = rsContacts("FirstName") & " " & rsContacts("LastName")
      strLtrContent = strLtrContent & rsContacts("Address") & vbCrLf
      strLtrContent = strLtrContent & rsContacts("City") & ", " & rsContacts("Region")
      strLtrContent = strLtrContent & "  " & rsContacts("PostalCode") 
      strLtrContent = strLtrContent & "Dear " & rsContacts("FirstName") & " "
      strLtrContent = strLtrContent & rsContacts("LastName") & ":" 
    
        objWord.Selection.EndOf
        objWord.Selection.Text = strLtrContent
    
        objWord.Selection.EndOf
        objWord.Selection.InsertBreak
        
        rsContacts.MoveNext
    Loop
    objWord.Visible = True
    objWord.PrintPreview = True
End Sub



Open an Existing Document

 
Sub Main()
    Dim wdApp As Word.Application
    
    Set wdApp = GetObject(, "Word.Application")
    wdApp.Documents.Open Filename:="C:\Arrays.docx", ReadOnly:=True, AddtoRecentFiles:=False
End Sub



Save a document

 
Sub WordLateBound() 
    Dim objWord As Object 
    Dim objDoc As Object 
    Set objWord = CreateObject("Word.Application") 
    Set objDoc = objWord.Documents.Add 
    objDoc.SaveAs "C:\testdoc2.doc" 
    objDoc.Close 
    Set objDoc = Nothing 
    Set objWord = Nothing 
End Sub



Save Changes to a Document

 
Sub main()
    Dim wdApp As Word.Application
    
    Set wdApp = GetObject(, "Word.Application")
    wdApp.Documents.Save
End Sub



To close a specific document, you can close the active document or you can specify a document name:

 
Sub main()
    Dim wdApp As Word.Application
    Set wdApp = GetObject(, "Word.Application")
    wdApp.ActiveDocument.Close
    "or
    wdApp.Documents("Arrays.docx").Close
End Sub



To create a new document that uses a specific template, use this:

 
Sub add()
    Dim wdApp As Word.Application
    
    Set wdApp = GetObject(, "Word.Application")
    wdApp.Documents.Add Template:="Contemporary Memo.dot"
End Sub



To save a document with a new name, use the SaveAs method

 
Sub Main()
    Dim wdApp As Word.Application
    Set wdApp = GetObject(, "Word.Application")
    wdApp.ActiveDocument.SaveAs "C:\MemoTest.docx"
End Sub