Consulting

Results 1 to 11 of 11

Thread: writte Word doc content from excel using styles

  1. #1
    VBAX Regular
    Joined
    Mar 2018
    Posts
    10
    Location

    Exclamation writte Word doc content from excel using styles

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

    DummyData.xlsx

    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.

  2. #2
    VBAX Mentor
    Joined
    Aug 2012
    Posts
    367
    Location
    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
    Remember: it is the second mouse that gets the cheese.....

  3. #3
    VBAX Mentor
    Joined
    Aug 2012
    Posts
    367
    Location
    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
    Remember: it is the second mouse that gets the cheese.....

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Mentor
    Joined
    Aug 2012
    Posts
    367
    Location
    and Workbooks.Close(fileName:=myString) will close the data file when you are done with it
    Remember: it is the second mouse that gets the cheese.....

  6. #6
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by werafa View Post
    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...
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  7. #7
    VBAX Regular
    Joined
    Mar 2018
    Posts
    10
    Location
    Quote Originally Posted by macropod View Post
    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!

  8. #8
    VBAX Mentor
    Joined
    Aug 2012
    Posts
    367
    Location
    hi Paul,

    you are correct - I believe I put my response on the wrong post
    oh dear
    Remember: it is the second mouse that gets the cheese.....

  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by Ani View Post
    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"
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  10. #10
    VBAX Regular
    Joined
    Mar 2018
    Posts
    10
    Location
    Quote Originally Posted by macropod View Post
    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

  11. #11
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •