writte Word doc content from excel using styles

[Ani]

I think this thread will go for little while.
Every hint or help is appreciated.

21783

In the file there is only some dummy data but i explain what i need to accomplish.
I need the excel file to create a new word document and on it to create styles with the given names (Names and properties if possible and they can be hard coded)
After that i want the excel to get the text from each row to get each cell data and if its not blank (blank can be a formula that returns error or space or just no char text "") to write the text in the word document as a paragraph and apply defined style for that column to the text.
I think the goal is clear enough.

Anyone reading and/or trying to help Thank you in advance.

[werafa]

step by step,

open a file,
loop
extract some data
manage errors
paste into word
end loop

I'm not familiar with word vba, but this should let you open a file and get at some data


fileName = fileArray(myMonth, 3) myPath = fileArray(myMonth, 4)
myString = myPath & "/" & fileName

If BookOpen(fileName) = True Then Workbooks(fileName).Close SaveChanges:=True

If Dir(myString) <> "" Then 'workbook name exists at location
Set dataWB = Workbooks.Open(fileName:=myString)
Else
myWB.Worksheets("Admin").Cells(myMonth + 6, 4).Value = "File Missing"
End If

DoEvents 'ensure file opens fully before continuing

and to manage file locations


Sub GetFilePath(myRow As Long)'Return file name and path to worksheet cells


Dim myObject As Object
Dim fileSelected As String
Dim myPath As String
Dim myFile As String
Dim strLen As Integer


Set myObject = Application.FileDialog(msoFileDialogOpen)

With myObject
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
fileSelected = .SelectedItems(1)
End With

strLen = Len(fileSelected) - InStrRev(fileSelected, "\")
myFile = Right(fileSelected, strLen)
strLen = Len(fileSelected) - strLen - 1
myPath = Left(fileSelected, strLen)

With Worksheets("Admin")
.Range("G" & myRow) = myPath 'The file path
.Range("F" & myRow) = myFile 'The file name
.Range("C" & myRow, "D" & myRow).Font.Color = vbBlack
If Len(myFile) > 0 Then
.Range("D" & myRow).Value = "File Located"
Else
.Range("D" & myRow).Value = "No File"
End If
End With
End Sub

[werafa]

Private Function BookOpen(strBookName As String) As Boolean'test whether worbook is already open
Dim oBk As Workbook
On Error Resume Next
Set oBk = Workbooks(strBookName)
On Error GoTo 0
If oBk Is Nothing Then
BookOpen = False
Else
BookOpen = True
End If
End Function

[macropod]

Try something based on:

Sub WriteToDoc()
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, WdDoc As Word.document, StrNm As String
Dim xlWkSht As Worksheet, r As Long, c As Long, lRow As Long, lCol As Long
Set xlWkSht = ThisWorkbook.Worksheets("Sheet1")
With xlWkSht.UsedRange.Cells.SpecialCells(xlCellTypeLastCell)
lRow = .Row
lCol = .Column
End With
With wdApp
.Visible = True
Set WdDoc = .Documents.Add
With WdDoc.Range
For r = 2 To lRow
For c = 1 To lCol
If xlWkSht.Cells(r, c).Text <> "" Then
.InsertAfter xlWkSht.Cells(r, c).Text
.Paragraphs.Last.Style = xlWkSht.Cells(1, c).Text
If r * c < lRow * lCol Then .InsertAfter vbCr
End If
Next
Next
End With
End With
Set WdDoc = Nothing: Set wdApp = Nothing: Set xlWkSht = Nothing
End Sub

[werafa]

and Workbooks.Close(fileName:=myString) will close the data file when you are done with it

[macropod]

and Workbooks.Close(fileName:=myString) will close the data file when you are done with it
Given what the OP stated in post #1, what makes you think the workbook needs to be opened or closed via code? None of your posts in this thread actually addresses the question that was asked. Do try to be relevant...

[Ani]

Try something based on:

Sub WriteToDoc()
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, WdDoc As Word.document, StrNm As String
Dim xlWkSht As Worksheet, r As Long, c As Long, lRow As Long, lCol As Long
Set xlWkSht = ThisWorkbook.Worksheets("Sheet1")
With xlWkSht.UsedRange.Cells.SpecialCells(xlCellTypeLastCell)
lRow = .Row
lCol = .Column
End With
With wdApp
.Visible = True
Set WdDoc = .Documents.Add
With WdDoc.Range
For r = 2 To lRow
For c = 1 To lCol
If xlWkSht.Cells(r, c).Text <> "" Then
.InsertAfter xlWkSht.Cells(r, c).Text
.Paragraphs.Last.Style = xlWkSht.Cells(1, c).Text
If r * c < lRow * lCol Then .InsertAfter vbCr
End If
Next
Next
End With
End With
Set WdDoc = Nothing: Set wdApp = Nothing: Set xlWkSht = Nothing
End Sub

Thank you!
This code works great. will see if i can create new styles set to row 1 if they dont already exist. Anyway this does somehow solve what i posted this thread for because i can create the word document manually with styles and open that one.
Will leave thread opened just so if i do create styles i post the code!:thumb

[werafa]

hi Paul,

you are correct - I believe I put my response on the wrong post :)
oh dear

[macropod]

will see if i can create new styles set to row 1 if they dont already exist
Conditionally creating Styles is the easy part - you'd also need to define their parameters (e.g. font name, size, italics, etc.; paragraph alignment, indents, before/after spacing, etc) before they'd be much use. The best course is to make sure you use a template containing all the Styles you need. You can specify the template via the existing .Documents.Add line. For example:

.Documents.Add Template:="C:\File_Path\Template_Name.dotx"

[Ani]

Conditionally creating Styles is the easy part - you'd also need to define their parameters (e.g. font name, size, italics, etc.; paragraph alignment, indents, before/after spacing, etc) before they'd be much use. The best course is to make sure you use a template containing all the Styles you need. You can specify the template via the existing .Documents.Add line. For example:

.Documents.Add Template:="C:\File_Path\Template_Name.dotx"


Yes found the code


X = ActiveDocument.Styles.Count
For i = 1 To X
If "DeleteStyle" = ActiveDocument.Styles(i) Then
GoTo CONTINUE ' ****** We'll skip if style already present **********
End If
Next
' ************ If we dropped to here -- we need to create the new style ********
ActiveDocument.Styles.Add Name:="DeleteStyle", Type:=wdStyleTypeParagraph
With ActiveDocument.Styles("DeleteStyle")
.AutomaticallyUpdate = False
.BaseStyle = "Normal" ' ******* Start with normal and vary it from there
.NextParagraphStyle = "DeleteStyle"
End With
' *********** Deefining the particular style **********
With ActiveDocument.Styles("DeleteStyle").Font
.Bold = True
.ColorIndex = wdRed
End With
CONTINUE:


Thank you!
Haven't tested but seems fine

[macropod]

Instead of looping through all existing Styles and your other circumlocution you could use:

Const strStl As String = "MyStyle"
On Error Resume Next
With ActiveDocument
If .Styles(strStl) Is Nothing Then
.Styles.Add (strStl)
With .Styles(strStl)
.AutomaticallyUpdate = False
.BaseStyle = "Normal"
.NextParagraphStyle = strStl
With .Font
.Bold = True
.ColorIndex = wdRed
End With
End With
End If
End With
On Error GoTo 0