whitedash
03-02-2017, 11:33 PM
Hi all,
I've picked up VBA recently and still have much to learn.
Use case
I am trying to use excel to create a program to generate word documents based on a given template with data specified in the excel sheet.
The template will have Title, Body Text, Table, Image, bulleted points and etc. I've only managed to code the title and body text using text box to format the template. Is there a way to remove the text box and reference based on paragraph instead as it is really clunky now. I also need to have different style for title and body text. Any experts out there that can help me?
Sub GeneratePage()
Application.ScreenUpdating = False
Dim tt As String
Dim st As String
Dim mb As String
Dim sb As String
Dim rowNum As Variant
If MsgBox("Batch update?", vbYesNo, "Batch") = vbYes Then
i = 2
Do While Sheets("Content").Range("A" & i).Value <> ""
With Sheets("Content")
tt = .Range("A" & i)
st = .Range("B" & i)
mb = .Range("C" & i)
sb = .Range("D" & i)
End With
Call InputFields(tt, st, mb, sb, True, tt)
i = i + 1
Loop
Else
rowNum = " "
Do While Not (AppropriateRowNum(rowNum))
If rowNum = "" Then Exit Sub
rowNum = InputBox("Which row do you want to generate?", "Row Number")
Loop
With Sheets("Content")
tt = .Range("A" & rowNum)
st = .Range("B" & rowNum)
mb = .Range("C" & rowNum)
sb = .Range("D" & rowNum)
End With
Call InputFields(tt, st, mb, sb, True, tt)
End If
Call InputFields("Title", "Subtitle", "Body", "Sub body")
Sheets("Content").Activate
Application.ScreenUpdating = True
End Sub
Function AppropriateRowNum(test As Variant) As Boolean
AppropriateRowNum = False
If IsNumeric(test) Then If test - Int(test) = 0 Then If test > 1 Then AppropriateRowNum = True
End Function
Sub InputFields(tt As String, st As String, mb As String, sb As String, Optional saveDoc As Boolean = False, Optional filename As String)
Dim WApp As Word.Application
Dim WDoc As Word.Document
Dim oleObj As OLEObject
Set oleObj = Sheets("Template").OLEObjects(1)
oleObj.Activate
oleObj.Object.Application.Visible = False
Set WApp = GetObject(, "Word.Application")
Set WDoc = WApp.ActiveDocument
With WDoc
.Shapes(1).TextFrame.TextRange = tt
.Shapes(2).TextFrame.TextRange = st
.Shapes(3).TextFrame.TextRange = mb
.Shapes(4).TextFrame.TextRange = sb
End With
If saveDoc = True Then
Sheets("Template").Range("A1").Select
WDoc.SaveAs ActiveWorkbook.Path & "\" & filename & ".docx"
End If
End Sub
I've picked up VBA recently and still have much to learn.
Use case
I am trying to use excel to create a program to generate word documents based on a given template with data specified in the excel sheet.
The template will have Title, Body Text, Table, Image, bulleted points and etc. I've only managed to code the title and body text using text box to format the template. Is there a way to remove the text box and reference based on paragraph instead as it is really clunky now. I also need to have different style for title and body text. Any experts out there that can help me?
Sub GeneratePage()
Application.ScreenUpdating = False
Dim tt As String
Dim st As String
Dim mb As String
Dim sb As String
Dim rowNum As Variant
If MsgBox("Batch update?", vbYesNo, "Batch") = vbYes Then
i = 2
Do While Sheets("Content").Range("A" & i).Value <> ""
With Sheets("Content")
tt = .Range("A" & i)
st = .Range("B" & i)
mb = .Range("C" & i)
sb = .Range("D" & i)
End With
Call InputFields(tt, st, mb, sb, True, tt)
i = i + 1
Loop
Else
rowNum = " "
Do While Not (AppropriateRowNum(rowNum))
If rowNum = "" Then Exit Sub
rowNum = InputBox("Which row do you want to generate?", "Row Number")
Loop
With Sheets("Content")
tt = .Range("A" & rowNum)
st = .Range("B" & rowNum)
mb = .Range("C" & rowNum)
sb = .Range("D" & rowNum)
End With
Call InputFields(tt, st, mb, sb, True, tt)
End If
Call InputFields("Title", "Subtitle", "Body", "Sub body")
Sheets("Content").Activate
Application.ScreenUpdating = True
End Sub
Function AppropriateRowNum(test As Variant) As Boolean
AppropriateRowNum = False
If IsNumeric(test) Then If test - Int(test) = 0 Then If test > 1 Then AppropriateRowNum = True
End Function
Sub InputFields(tt As String, st As String, mb As String, sb As String, Optional saveDoc As Boolean = False, Optional filename As String)
Dim WApp As Word.Application
Dim WDoc As Word.Document
Dim oleObj As OLEObject
Set oleObj = Sheets("Template").OLEObjects(1)
oleObj.Activate
oleObj.Object.Application.Visible = False
Set WApp = GetObject(, "Word.Application")
Set WDoc = WApp.ActiveDocument
With WDoc
.Shapes(1).TextFrame.TextRange = tt
.Shapes(2).TextFrame.TextRange = st
.Shapes(3).TextFrame.TextRange = mb
.Shapes(4).TextFrame.TextRange = sb
End With
If saveDoc = True Then
Sheets("Template").Range("A1").Select
WDoc.SaveAs ActiveWorkbook.Path & "\" & filename & ".docx"
End If
End Sub