https://youtu.be/-eo4QEnLVOg
Wednesday, March 30, 2016
Monday, March 28, 2016
Tuesday, March 22, 2016
MICROSOFT ACCESS 2010 VBA - WRITE TO MS WORD DOCUMENT
''' MICROSOFT ACCESS 2010 VBA - WRITE TO MS WORD DOCUMENT '''
'''''''''''''''''''''''''''''''''
https://youtu.be/iUYWzS7YdGI
Option Compare Database
Option Explicit
Private Sub lblEnglishSpaceDog_Click()
Dim theWordApp As Word.Application
Dim theWordDoc As Word.Document
Dim theOpenFileName As String
Dim theSaveFileName As String
Dim theString As String
theOpenFileName = "C:\SHTUFF\Aardvark.docx"
' check if Word is already running, if not, instantiate it.
On Error Resume Next
Error.Clear
Set theWordApp = GetObject(, "word.application")
If Err.Number <> 0 Then ' if Word is not already running
Set theWordApp = New Word.Application 'instantiate
End If
On Error GoTo 0
theWordApp.Visible = True
''''''''''
' OPEN THE WORD DOC.
''''''''''''
Set theWordDoc = theWordApp.Documents.Open(theOpenFileName, , True)
theWordApp.Activate
With theWordApp
theWordDoc.Content.InsertBefore "*HELLO world*" 'WRITE A LINE BEFORE THE EXISTIN TEXT
' Type and Format Text
With .Selection 'curr.position in Word doc.
.ParagraphFormat.Alignment = wdAlignParagraphCenter 'center this text
.BoldRun 'turn on bold
.Font.Size = 16
.TypeText "*** ENGLISHSPACEDOG ***" 'in the Word doc.
.BoldRun 'toggle off bold
.TypeText vbNewLine & "** 2016 **" 'go to a new line and type stuff.
.TypeParagraph
.Font.Size = 11
.ParagraphFormat.Alignment = wdAlignParagraphLeft 'WorD constant
.TypeParagraph ' start a new paragraph.
.TypeText "*QWERTY*" ' and type stuff.
End With 'Selection
theString = InputBox("type somethin", 100, 100) 'pause
theWordDoc.Content.InsertAfter ">>>" & theString & "<<<" 'WRITE A LINE AFTER allTHE EXISTIN TEXT
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Save WORD Document
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
theSaveFileName = "C:\SHTUFF\Aardvark " & _
Format(Now, "yyyy-mm-dd hh-mm-ss") & ".docx" '<<<<<< filename contains date/timestamp <<<<<<<
'(SaveAs is for Office 2003 and earlier - deprecated)
.ActiveDocument.SaveAs2 theSaveFileName '<<<<<< filename <<<<<<<
'replaces existing .doc iff exists
' Close Document and Quit Word
.ActiveDocument.Close 'close .DOC
.Quit 'exit Word
End With
Set theWordDoc = Nothing 'garbage collection'
Set theWordApp = Nothing
End Sub
'''''''''''''''''''''''''''''''''
https://youtu.be/iUYWzS7YdGI
Option Compare Database
Option Explicit
Private Sub lblEnglishSpaceDog_Click()
Dim theWordApp As Word.Application
Dim theWordDoc As Word.Document
Dim theOpenFileName As String
Dim theSaveFileName As String
Dim theString As String
theOpenFileName = "C:\SHTUFF\Aardvark.docx"
' check if Word is already running, if not, instantiate it.
On Error Resume Next
Error.Clear
Set theWordApp = GetObject(, "word.application")
If Err.Number <> 0 Then ' if Word is not already running
Set theWordApp = New Word.Application 'instantiate
End If
On Error GoTo 0
theWordApp.Visible = True
''''''''''
' OPEN THE WORD DOC.
''''''''''''
Set theWordDoc = theWordApp.Documents.Open(theOpenFileName, , True)
theWordApp.Activate
With theWordApp
theWordDoc.Content.InsertBefore "*HELLO world*" 'WRITE A LINE BEFORE THE EXISTIN TEXT
' Type and Format Text
With .Selection 'curr.position in Word doc.
.ParagraphFormat.Alignment = wdAlignParagraphCenter 'center this text
.BoldRun 'turn on bold
.Font.Size = 16
.TypeText "*** ENGLISHSPACEDOG ***" 'in the Word doc.
.BoldRun 'toggle off bold
.TypeText vbNewLine & "** 2016 **" 'go to a new line and type stuff.
.TypeParagraph
.Font.Size = 11
.ParagraphFormat.Alignment = wdAlignParagraphLeft 'WorD constant
.TypeParagraph ' start a new paragraph.
.TypeText "*QWERTY*" ' and type stuff.
End With 'Selection
theString = InputBox("type somethin", 100, 100) 'pause
theWordDoc.Content.InsertAfter ">>>" & theString & "<<<" 'WRITE A LINE AFTER allTHE EXISTIN TEXT
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Save WORD Document
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
theSaveFileName = "C:\SHTUFF\Aardvark " & _
Format(Now, "yyyy-mm-dd hh-mm-ss") & ".docx" '<<<<<< filename contains date/timestamp <<<<<<<
'(SaveAs is for Office 2003 and earlier - deprecated)
.ActiveDocument.SaveAs2 theSaveFileName '<<<<<< filename <<<<<<<
'replaces existing .doc iff exists
' Close Document and Quit Word
.ActiveDocument.Close 'close .DOC
.Quit 'exit Word
End With
Set theWordDoc = Nothing 'garbage collection'
Set theWordApp = Nothing
End Sub
Monday, March 21, 2016
Export Data from Excel to Word template with Multiple Bookmarks
https://youtu.be/iyOBsaHXUJg
''''''''''''''''''''''''''''' ENGLISHSPACEDOG '''''''''''''''''''''''''''''''''''''''''''
Option Explicit '''''''''' THIS IS VBA IN EXCEL 2010 ''''''''''''''''''''''''''''''''''''''''''
Option Base 1 ' means that arrays start from 1, not 0.
Sub ExportExcelDataToWordDocument()
'Dim wdExcelApp As Application 'Excel is the default library (optional)
Dim wdWordApp As Word.Application 'Word app
Dim theString As String
Dim theObject As Object
' Creating a new instance of Word
Set wdWordApp = New Word.Application 'instantiate a new instance of Word 2010
With wdWordApp
' Making Word Visible on the screen
.Visible = True 'iff false, document is invisible.
.Activate ' make it the top pane, bring it to the front.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' create a new Word Document based on the specified template
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.Documents.Add "C:\SHTUFF\MY FAVORITE PLAYER.dotm"
Sheet2.Activate
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'put the value of cell B2 into Bookmark "b1".
theString = Range("B2").Value 'cast to string
Set theObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
theObject.SetText theString
theObject.PutInClipboard 'copy from cell B2 to clipboard.
Set theObject = Nothing
.Selection.GoTo what:=-1, Name:="b1" ' -1 means "wdgotobookmark"
.Selection.Paste 'paste from the clipboard to the Word Doc.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'put the value of cell C2 into Bookmark "b2".
theString = Range("C2").Value 'cast to string
Set theObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
theObject.SetText theString
theObject.PutInClipboard 'copy from cell to clipboard.
Set theObject = Nothing
.Selection.GoTo what:=-1, Name:="b2" ' -1 means "wdgotobookmark"
.Selection.Paste 'paste from the clipboard to the Word Doc.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'put the value of cell A2 into Bookmark "b3".
theString = Range("A2").Value 'cast to string
Set theObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
theObject.SetText theString
theObject.PutInClipboard 'copy from cell to clipboard.
Set theObject = Nothing
.Selection.GoTo what:=-1, Name:="b3" ' -1 means "wdgotobookmark"
.Selection.Paste 'paste from the clipboard to the Word Doc.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Save WORD Document
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TheFileName As String
TheFileName = "C:\SHTUFF\MY FAVORITE PLAYER.docx"
'(SaveAs is for Office 2003 and earlier)
.ActiveDocument.SaveAs2 TheFileName
'replaces existing .doc iff exists
' Close Documents and Quit Word
.ActiveDocument.Close 'close .DOCx
.Quit 'exit Word
End With
'MEMORY CLEANUP
Set wdWordApp = Nothing 'garbage collection
'Set wdExcelApp = Nothing 'OPTIONAL
End Sub
'''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''' ENGLISHSPACEDOG '''''''''''''''''''''''''''''''''''''''''''
Option Explicit '''''''''' THIS IS VBA IN EXCEL 2010 ''''''''''''''''''''''''''''''''''''''''''
Option Base 1 ' means that arrays start from 1, not 0.
Sub ExportExcelDataToWordDocument()
'Dim wdExcelApp As Application 'Excel is the default library (optional)
Dim wdWordApp As Word.Application 'Word app
Dim theString As String
Dim theObject As Object
' Creating a new instance of Word
Set wdWordApp = New Word.Application 'instantiate a new instance of Word 2010
With wdWordApp
' Making Word Visible on the screen
.Visible = True 'iff false, document is invisible.
.Activate ' make it the top pane, bring it to the front.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' create a new Word Document based on the specified template
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.Documents.Add "C:\SHTUFF\MY FAVORITE PLAYER.dotm"
Sheet2.Activate
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'put the value of cell B2 into Bookmark "b1".
theString = Range("B2").Value 'cast to string
Set theObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
theObject.SetText theString
theObject.PutInClipboard 'copy from cell B2 to clipboard.
Set theObject = Nothing
.Selection.GoTo what:=-1, Name:="b1" ' -1 means "wdgotobookmark"
.Selection.Paste 'paste from the clipboard to the Word Doc.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'put the value of cell C2 into Bookmark "b2".
theString = Range("C2").Value 'cast to string
Set theObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
theObject.SetText theString
theObject.PutInClipboard 'copy from cell to clipboard.
Set theObject = Nothing
.Selection.GoTo what:=-1, Name:="b2" ' -1 means "wdgotobookmark"
.Selection.Paste 'paste from the clipboard to the Word Doc.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'put the value of cell A2 into Bookmark "b3".
theString = Range("A2").Value 'cast to string
Set theObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
theObject.SetText theString
theObject.PutInClipboard 'copy from cell to clipboard.
Set theObject = Nothing
.Selection.GoTo what:=-1, Name:="b3" ' -1 means "wdgotobookmark"
.Selection.Paste 'paste from the clipboard to the Word Doc.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Save WORD Document
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TheFileName As String
TheFileName = "C:\SHTUFF\MY FAVORITE PLAYER.docx"
'(SaveAs is for Office 2003 and earlier)
.ActiveDocument.SaveAs2 TheFileName
'replaces existing .doc iff exists
' Close Documents and Quit Word
.ActiveDocument.Close 'close .DOCx
.Quit 'exit Word
End With
'MEMORY CLEANUP
Set wdWordApp = Nothing 'garbage collection
'Set wdExcelApp = Nothing 'OPTIONAL
End Sub
'''''''''''''''''''''''''''''''''''
Sunday, March 20, 2016
Friday, March 18, 2016
Export Excel to Word Template
The corresponding YouTube video is here:
https://youtu.be/BoQF9EaXZYg
''''''''''''''''''''''''''''' ENGLISHSPACEDOG '''''''''''''''''''''''''''''''''''''''''''
Option Explicit '''''''''' THIS IS VBA IN EXCEL 2010 ''''''''''''''''''''''''''''''''''''''''''
Option Base 1
Sub ExportExcelDataToWordDocument()
'Dim wdExcelApp As Application 'Excel is the default library (optional)
Dim wdWordApp As Word.Application 'Word app
' Creating a new instance of Word
Set wdWordApp = New Word.Application 'instantiate a new instance of Word 2010
With wdWordApp
' Making Word Visible on the screen
.Visible = True 'iff false, document is invisible.
.Activate ' make it the top pane, bring it to the front.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' create a new Word Document based on the specified template
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.Documents.Add "C:\SHTUFF\syzygy.dotm"
'as before, copy the whole table from sheet to clipboard.
Sheet2.Activate
Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy
.Selection.GoTo what:=-1, Name:="bookmark1" ' -1 means "wdgotobookmark"
.Selection.Paste 'paste from the clipboard to the Word Doc.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Save WORD Document
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TheFileName As String
TheFileName = "C:\SHTUFF\April.docx"
'(SaveAs is for Office 2003 and earlier - deprecated)
.ActiveDocument.SaveAs2 TheFileName
'replaces existing .doc iff exists
' Close Documents and Quit Word
.ActiveDocument.Close 'close .DOCx
.Quit 'exit Word
End With
'MEMORY CLEANUP
Set wdWordApp = Nothing 'garbage collection
'Set wdExcelApp = Nothing 'OPTIONAL
End Sub
'''''''''''''''''''''''''''''''''''
https://youtu.be/BoQF9EaXZYg
''''''''''''''''''''''''''''' ENGLISHSPACEDOG '''''''''''''''''''''''''''''''''''''''''''
Option Explicit '''''''''' THIS IS VBA IN EXCEL 2010 ''''''''''''''''''''''''''''''''''''''''''
Option Base 1
Sub ExportExcelDataToWordDocument()
'Dim wdExcelApp As Application 'Excel is the default library (optional)
Dim wdWordApp As Word.Application 'Word app
' Creating a new instance of Word
Set wdWordApp = New Word.Application 'instantiate a new instance of Word 2010
With wdWordApp
' Making Word Visible on the screen
.Visible = True 'iff false, document is invisible.
.Activate ' make it the top pane, bring it to the front.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' create a new Word Document based on the specified template
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.Documents.Add "C:\SHTUFF\syzygy.dotm"
'as before, copy the whole table from sheet to clipboard.
Sheet2.Activate
Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy
.Selection.GoTo what:=-1, Name:="bookmark1" ' -1 means "wdgotobookmark"
.Selection.Paste 'paste from the clipboard to the Word Doc.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Save WORD Document
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TheFileName As String
TheFileName = "C:\SHTUFF\April.docx"
'(SaveAs is for Office 2003 and earlier - deprecated)
.ActiveDocument.SaveAs2 TheFileName
'replaces existing .doc iff exists
' Close Documents and Quit Word
.ActiveDocument.Close 'close .DOCx
.Quit 'exit Word
End With
'MEMORY CLEANUP
Set wdWordApp = Nothing 'garbage collection
'Set wdExcelApp = Nothing 'OPTIONAL
End Sub
'''''''''''''''''''''''''''''''''''
How to Export Spreadsheet Data from EXCEL 2010 to Microsoft WORD
Here's the VBA code below for my latest YouTube video:
https://youtu.be/W6dIjZK06pU
''''''''''''''''''''''''''''' ENGLISHSPACEDOG '''''''''''''''''''''''''''''''''''''''''''
Option Explicit '''''''''' THIS IS VBA IN EXCEL 2010 ''''''''''''''''''''''''''''''''''''''''''
Option Base 1
Sub ExportExcelDataToWordDocument()
Dim wdExcelApp As Application 'Excel is the default library (optional)
Dim wdWordApp As Word.Application 'Word app
' Creating a new instance of Word
Set wdWordApp = New Word.Application 'instantiate a new instance of Word 2010
With wdWordApp
' Making Word Visible on the screen
.Visible = True 'iff false, document is invisible.
.Activate ' make it the top pane, bring it to the front.
' Creating a New Document
.Documents.Add 'add a new DOC (Document1.doc or .docx or .docm)
' Type Text
With .Selection 'curr.position in Word doc.
.ParagraphFormat.Alignment = wdAlignParagraphCenter 'center this text
.BoldRun 'turn on bold
.Font.Size = 14
.TypeText "This is the Title" 'in the Word doc.
.BoldRun 'toggle off bold
.TypeText vbNewLine & "WHO" 'go to a new line and type stuff.
.TypeParagraph
.Font.Size = 11
.ParagraphFormat.Alignment = wdAlignParagraphLeft 'WorD constant
.TypeParagraph ' start a new paragraph.
.TypeText "what" ' and type stuff.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copy from Excel into Word
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheet2.Activate ' goto sheet2
Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy ' copy data to clipboard
.Paste 'paste from the clipboard to the Word Doc.
End With 'Selection
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Save WORD Document
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TheFileName As String
TheFileName = "C:\SHTUFF\Aardvark.docx"
'(SaveAs is for Office 2003 and earlier - deprecated)
.ActiveDocument.SaveAs2 TheFileName
'replaces existing .doc iff exists
' Close Documents and Quit Word
.ActiveDocument.Close 'close .DOCx
.Quit 'exit Word
End With
'MEMORY CLEANUP
Set wdWordApp = Nothing 'garbage collection
Set wdExcelApp = Nothing 'OPTIONAL
End Sub
'''''''''''''''''''''''''''''''''''
https://youtu.be/W6dIjZK06pU
''''''''''''''''''''''''''''' ENGLISHSPACEDOG '''''''''''''''''''''''''''''''''''''''''''
Option Explicit '''''''''' THIS IS VBA IN EXCEL 2010 ''''''''''''''''''''''''''''''''''''''''''
Option Base 1
Sub ExportExcelDataToWordDocument()
Dim wdExcelApp As Application 'Excel is the default library (optional)
Dim wdWordApp As Word.Application 'Word app
' Creating a new instance of Word
Set wdWordApp = New Word.Application 'instantiate a new instance of Word 2010
With wdWordApp
' Making Word Visible on the screen
.Visible = True 'iff false, document is invisible.
.Activate ' make it the top pane, bring it to the front.
' Creating a New Document
.Documents.Add 'add a new DOC (Document1.doc or .docx or .docm)
' Type Text
With .Selection 'curr.position in Word doc.
.ParagraphFormat.Alignment = wdAlignParagraphCenter 'center this text
.BoldRun 'turn on bold
.Font.Size = 14
.TypeText "This is the Title" 'in the Word doc.
.BoldRun 'toggle off bold
.TypeText vbNewLine & "WHO" 'go to a new line and type stuff.
.TypeParagraph
.Font.Size = 11
.ParagraphFormat.Alignment = wdAlignParagraphLeft 'WorD constant
.TypeParagraph ' start a new paragraph.
.TypeText "what" ' and type stuff.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copy from Excel into Word
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheet2.Activate ' goto sheet2
Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy ' copy data to clipboard
.Paste 'paste from the clipboard to the Word Doc.
End With 'Selection
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Save WORD Document
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TheFileName As String
TheFileName = "C:\SHTUFF\Aardvark.docx"
'(SaveAs is for Office 2003 and earlier - deprecated)
.ActiveDocument.SaveAs2 TheFileName
'replaces existing .doc iff exists
' Close Documents and Quit Word
.ActiveDocument.Close 'close .DOCx
.Quit 'exit Word
End With
'MEMORY CLEANUP
Set wdWordApp = Nothing 'garbage collection
Set wdExcelApp = Nothing 'OPTIONAL
End Sub
'''''''''''''''''''''''''''''''''''
Sunday, March 6, 2016
Subscribe to:
Posts (Atom)