PDA

View Full Version : VBA help in coding



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