writte Word doc content from excel using styles

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

Attachment 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.

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

Code:

---

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

Code:

---

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

---

Code:

---

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

---

Try something based on:

Code:

---

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

---

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

Quote:

---

Originally Posted by werafa

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...

Quote:

---

Originally Posted by macropod

Try something based on:

Code:

---

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

hi Paul,

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

Quote:

---

Originally Posted by Ani

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"

Quote:

---

Originally Posted by macropod

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

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

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

Code:

---

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

---