Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Jun 2015
    Posts
    4
    Thanks
    2
    Thanked 0 Times in 0 Posts

    VBA in Word, how to copy cells from a table into another word document that has contentcontrol

    Hello everyone,


    I have two word documents, one document used content control (Test_www.docx) and the other document (Test daily.docx) has a table.


    I have to physically copy each cell from one table into the content controlled document. And it is a utter pain. I want to copy the table from Test daily.docx into the content control document Test_www.docx.


    I want to copy the following items from Test daily.docx -> Test_www.docx


    time ---------------------------------------------------------> From To
    Details of Events/Activities ---------------------------------> Description.


    I want this to continue until the end of the day at 23:59. If I have a very busy day this is very painful.




    Time Details of Events/Activities
    00:00 Some text
    05:46 Some text




    From To Activity Type Code Description
    00:00 05:46 Choose activity type SUR (text) Some text
    05:46 06:00 Choose activity type SUR (text) Some text
    .................................................. ....
    23:59 23:59 Choose activity type SUR (text) Some text




    Below are the two sample files I am working with:



    Test www.docx
    Test daily.docx




    I made several attempts at this but I cannot wrap my head around VBA in word. Hopefully I have enough scraps of code for someone to help me out. I would be grateful for any working macro.




    Attempt #1 have two documents open, copy from one file to another. I use, find then extend mode feature in word to select the right items.




    Code:
    Sub CopyFromSecondDoc()
    '
    ' CopyFromSecondDoc Macro
    ' from http://windowssecrets.com/forums/showthread.php/135517-Macro-to-copy-from-one-document-to-another
    '
    Dim ThisDoc As Document
       Dim OtherDoc As Document
       
       If Documents.Count <> 2 Then
          MsgBox "Must only have two documents open!"
          Exit Sub
       End If
       
       Set ThisDoc = ActiveDocument
    
    
       If ThisDoc = Documents(1) Then
          Set OtherDoc = Documents(2)
       Else
          Set OtherDoc = Documents(1)
       End If
       
       OtherDoc.Activate
    '
    ' 
    'I'm trying to use the extendMode to select and copy all the times in Test daily.docx from 0000_2359
    '
    '
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "Time"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        Selection.MoveDown Unit:=wdLine, Count:=1
        Selection.Extend
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "23:59"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        Selection.Copy
    
    
    
    
    ' I'm trying to use the extendMode to select all the From rows in Test www.docx from 0000_2359 
    '   
       ThisDoc.Activate
    
    
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "Project Operational Log"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        Selection.MoveDown Unit:=wdLine, Count:=1
        Selection.HomeKey Unit:=wdLine
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.HomeKey Unit:=wdLine
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.HomeKey Unit:=wdLine
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.HomeKey Unit:=wdLine
        Selection.MoveDown Unit:=wdLine, Count:=1
        Selection.Extend
        Selection.MoveDown Unit:=wdLine, Count:=39
        On Error Resume Next
        'Selection.PasteAndFormat (wdPasteDefault)
        'Selection.MoveDown Unit:=wdCell
    
    
        OtherDoc.Activate
        Selection.Copy
        
        ThisDoc.Activate
        Selection.PasteAndFormat (wdPasteDefault)
       
       Set ThisDoc = Nothing
       Set OtherDoc = Nothing
    
    
    End Sub



    Attempt #2, this may be easier to implement. I tied to declare and assign the ContentControl items values in Test www.docx to the appropriate values in Test daily.docx




    Code:
    
    Sub demo2()
    Dim projectlog1cc1 As ContentControl
    Dim projectlog2cc2 As ContentControl
    Dim projectlog3cc3 As ContentControl
    Dim projectlog4cc4 As ContentControl
    Dim projectlog5cc5 As ContentControl
    Dim projectlog6cc6 As ContentControl
    Dim projectlog7cc7 As ContentControl
    Dim projectlog8cc8 As ContentControl
    Dim projectlog9cc9 As ContentControl
    Dim projectlog10cc10 As ContentControl
    Dim projectlog11cc11 As ContentControl
    Dim projectlog12cc12 As ContentControl
    Dim projectlog13cc13 As ContentControl
    Dim projectlog14cc14 As ContentControl
    Dim projectlog15cc15 As ContentControl
    Dim projectlog16cc16 As ContentControl
    Dim projectlog17cc17 As ContentControl
    Dim projectlog18cc18 As ContentControl
    Dim projectlog19cc19 As ContentControl
    Dim projectlog20cc20 As ContentControl
    Dim projectlog21cc21 As ContentControl
    Dim projectlog22cc22 As ContentControl
    Dim projectlog23cc23 As ContentControl
    Dim projectlog24cc24 As ContentControl
    Dim projectlog25cc25 As ContentControl
    Dim projectlog26cc26 As ContentControl
    Dim projectlog27cc27 As ContentControl
    Dim projectlog28cc28 As ContentControl
    Dim projectlog29cc29 As ContentControl
    Dim projectlog30cc30 As ContentControl
    Dim projectlog31cc31 As ContentControl
    Dim projectlog32cc32 As ContentControl
    Dim projectlog33cc33 As ContentControl
    Dim projectlog34cc34 As ContentControl
    Dim projectlog35cc35 As ContentControl
    Dim projectlog36cc36 As ContentControl
    Dim projectlog37cc37 As ContentControl
    Dim projectlog38cc38 As ContentControl
    Dim projectlog39cc39 As ContentControl
    Dim projectlog40cc40 As ContentControl
    'Dim projectlog41cc41 As ContentControl
    
    
    
    
    Set projectlog1cc1 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (1)").Item(1)
    Set projectlog2cc2 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (2)").Item(1)
    Set projectlog3cc3 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (3)").Item(1)
    Set projectlog4cc4 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (4)").Item(1)
    Set projectlog5cc5 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (5)").Item(1)
    Set projectlog6cc6 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (6)").Item(1)
    Set projectlog7cc7 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (7)").Item(1)
    Set projectlog8cc8 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (8)").Item(1)
    Set projectlog9cc9 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (9)").Item(1)
    Set projectlog10cc10 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (10)").Item(1)
    Set projectlog11cc11 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (11)").Item(1)
    Set projectlog12cc12 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (12)").Item(1)
    Set projectlog13cc13 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (13)").Item(1)
    Set projectlog14cc14 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (14)").Item(1)
    Set projectlog15cc15 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (15)").Item(1)
    Set projectlog16cc16 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (16)").Item(1)
    Set projectlog17cc17 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (17)").Item(1)
    Set projectlog18cc18 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (18)").Item(1)
    Set projectlog19cc19 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (19)").Item(1)
    Set projectlog20cc20 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (20)").Item(1)
    Set projectlog21cc21 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (21)").Item(1)
    Set projectlog22cc22 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (22)").Item(1)
    Set projectlog23cc23 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (23)").Item(1)
    Set projectlog24cc24 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (24)").Item(1)
    Set projectlog25cc25 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (25)").Item(1)
    Set projectlog26cc26 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (26)").Item(1)
    Set projectlog27cc27 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (27)").Item(1)
    Set projectlog28cc28 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (28)").Item(1)
    Set projectlog29cc29 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (29)").Item(1)
    Set projectlog30cc30 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (30)").Item(1)
    Set projectlog31cc31 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (31)").Item(1)
    Set projectlog32cc32 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (32)").Item(1)
    Set projectlog33cc33 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (33)").Item(1)
    Set projectlog34cc34 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (34)").Item(1)
    Set projectlog35cc35 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (35)").Item(1)
    Set projectlog36cc36 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (36)").Item(1)
    Set projectlog37cc37 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (37)").Item(1)
    Set projectlog38cc38 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (38)").Item(1)
    Set projectlog39cc39 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (39)").Item(1)
    Set projectlog40cc40 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (40)").Item(1)
    'Set projectlog41cc41 = ActiveDocument.SelectContentControlsByTitle("Project Operational Log - Description (41)").Item(1)
    
    
     
    'Here i'm not sure how to assign values to the content control items from the table in Test daily.docx  
    projectlog1cc1.Range.Text = "teee"
    
    
    
    
    End Sub

    Any help would be graciously appreciated.

  2. #2
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,853
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Try something like this. It will need a bunch of error checking but the concept is kind of straightforward.
    Code:
    Sub aTest()
      Dim srcDoc As Document, tgtDoc As Document
      Dim srcTable As Table, tgtTable As Table
      Dim i As Integer, strTime As String, strDesc As String
      
      Set srcDoc = Documents("Test daily (1).docx")
      Set tgtDoc = Documents("Test www.docx")
      Set srcTable = srcDoc.Tables(1)
      Set tgtTable = tgtDoc.Tables(1)
      
      For i = 2 To srcTable.Rows.Count
        strTime = srcTable.Cell(i, 1).Range.Text
        strTime = Left(strTime, Len(strTime) - 2)
        strDesc = srcTable.Cell(i, 2).Range.Text
        strDesc = Left(strDesc, Len(strDesc) - 2)
        tgtTable.Cell(i, 1).Range.ContentControls(1).Range.Text = strTime
        tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text = strDesc
      Next
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  3. The Following User Says Thank You to Andrew Lockton For This Useful Post:

    reesjordan (2015-06-17)

  4. #3
    New Lounger
    Join Date
    Jun 2015
    Posts
    4
    Thanks
    2
    Thanked 0 Times in 0 Posts
    Andrew,

    Thanks for the quick reply it's exactly what I required.

    With a few modifications, I got everything to work on the actual documents. There is one issue.

    When I save the document as a .docx and try to reopen it I get the following error:

    Errors2.jpg

    I traced down the error (basically by commenting each line out 1 by 1) to the following line of code:

    Code:
        tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text = strDesc
    The description field contains, letters, numbers, symbols ( ' ") and so forth so declaring this field as a sting should be good. I tried to edit this line of code and to find a solution online but nothing seems to work.

    Can you tell me what ContentControls(1) <- the (1) is for? From what I gather the '1' refers to the first ContentControl in that cell.

    Things I tired (one at a time of course) >
    -Dim strDesc as Variant
    -Changed tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text to .... .ContentControls(2), .ContentControls(3), .ContentControls(4), .ContentControls(5), .ContentControls(i) etc.
    -Ensure Word was updated

    Do you have any suggestions on how to fix this error?

    Jordan
    Last edited by reesjordan; 2015-06-17 at 23:38. Reason: Added things I tried

  5. #4
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,853
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Jordan

    The code might error in several obvious ways (and probably countless non-obvious ways).
    1. If the target table doesn't contain as many rows as the source table
    2. If the relevant cell in the target table doesn't contain at least one Content Control
    3. If the Content Control will not accept the string you are trying to feed it

    Content Controls(1) is saying the first Content Control in that range.

    Now, the xml error you get when reopening the target doc implies that there is at least one content control that contains invalid content. Without seeing your actual documents it is speculation but my guess is that maybe your target document contains linked content controls and the embedded xml file now contains invalid characters such as quotes or ampersands.
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  6. #5
    New Lounger
    Join Date
    Jun 2015
    Posts
    4
    Thanks
    2
    Thanked 0 Times in 0 Posts
    Andrew,

    Thanks for you assistance. But I found the error (after hours of trial and error). My source table contained a "Enter/Return" in the paragraph, which caused the file to become corrupt. From what I gathered online, contentcontrol don't handle the "Enter/Return" key too well.

    Example of my source table:

    Some text, some text.
    Goes here.

    I changed that particular cell to one paragraph:

    Some text, some text. Goes here.

    Now when I save my document and try to reopen it, I no longer receive the xml/corrupt file error.

    Is there a way to ignore or remove "Enter/Return" from cells?

    Jordan

  7. #6
    New Lounger
    Join Date
    Jun 2015
    Posts
    4
    Thanks
    2
    Thanked 0 Times in 0 Posts
    Andrew,

    Here is the code I have right now. Not very elegant but it works. How could I make it better?

    Code:
    Sub Update_Wdp()
    
      Dim srcDoc As Document, tgtDoc As Document, Ddp As Document, Wdp As Document
      Dim srcTable As Table, tgtTable As Table, srcDate As Table, tgtDate As Table
      Dim i As Integer, J As Integer, strTime As String, strDesc As String
      
    
    'Check to see if two documents are open, Ddp and Wdp
    MsgBox ("Must have Ddp & Wdp open!" & vbNewLine & vbNewLine & "Ensure Ddp is selected, not Wdp!")
       If Documents.Count <> 2 Then
          MsgBox ("Must have Ddp & Wdp open!")
       End If
       
    'Set word document #1 to Ddp and word document #2 to Wdp
    Set Ddp = activeDocument
    
       If Ddp = Documents(1) Then
          Set Wdp = Documents(2)
       Else
          Set Wdp = Documents(1)
       End If
    
    'Set Ddp as source and Wdp target
    Ddp.Activate
      Set srcDoc = Ddp
      Set tgtDoc = Wdp
      Set srcTable = srcDoc.Tables(3)
      Set tgtTable = tgtDoc.Tables(3)
      Set srcDate = srcDoc.Tables(1)
      Set tgtDate = tgtDoc.Tables(1)
      
    'Set Date and Clear contents in Wdp for Table 3 - Project Log and format
    Wdp.Activate
    Application.ScreenUpdating = False
      'Set Date
      tgtDate.Cell(1, 4).Range.contentControls(1).Range.Text = srcDate.Cell(2, 4).Range.Text
      'Clear contents in Wdp for Table 3 - Project Log and format
      For i = 2 To tgtTable.Rows.Count
        tgtTable.Cell(i, 1).Range.contentControls(1).Range.Text = "HH:MM"
        tgtTable.Cell(i, 1).Range.Font.Color = -603937025
        tgtTable.Cell(i, 2).Range.contentControls(1).Range.Text = "HH:MM"
        tgtTable.Cell(i, 2).Range.Font.Color = -603937025
        tgtTable.Cell(i, 5).Range.contentControls(1).Range.Text = "...."
        tgtTable.Cell(i, 5).Range.Font.Color = -603937025
      Next
        
    'Update contents in Wdp (Table 3 - Project Log) based on Ddp (Table 3 - Time and Details of Activities)
      For i = 2 To srcTable.Rows.Count
        strTime = srcTable.Cell(i, 1).Range.Text
        strTime = Left(strTime, Len(strTime) - 2)
        strDesc = srcTable.Cell(i, 2).Range.Text
        strDesc = Left(strDesc, Len(strDesc) - 2)
        tgtTable.Cell(i, 1).Range.contentControls(1).Range.Text = strTime
        tgtTable.Cell(i, 5).Range.contentControls(1).Range.Text = strDesc
      Next
    'Update contents in Wdp (Table 3 - Project Log) column 2
      For J = 3 To srcTable.Rows.Count
        strTime = srcTable.Cell(J, 1).Range.Text
        strTime = Left(strTime, Len(strTime) - 2)
        tgtTable.Cell((J - 1), 2).Range.contentControls(1).Range.Text = strTime
      Next J
    'Update last time of the day 23:59 in Wdp (Table 3 - Project Log) column 2
      For i = 2 To tgtTable.Rows.Count
        If tgtTable.Cell(i, 1).Range.contentControls(1).Range.Text = "23:59" Then
          tgtTable.Cell(i, 2).Range.contentControls(1).Range.Text = "23:59"
        End If
      Next
    
    Application.ScreenUpdating = True
    
    
    MsgBox ("NOTE: Content Controls don't always accept the:" & vbNewLine & vbNewLine & Space(30) & "ENTER/Return key" & vbNewLine & vbNewLine & "Ensure all your text in the DdP is in ONE paragraph.")
    
    End Sub

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
  •