none
Paste cell by cell into word from excel - loop help please! RRS feed

  • Question

  • I need some help in getting this macro to repeat copying content from a cell in excel over to word multiple times please.

    working in word vba

    Goal: I have a range in an excel workbook about 250 cells long in column C that is a list of figure titles. I want to paste all of those titles into Word, as ‘captions’ (while leaving space for me to go in and actually put the figures later, putting a consistent source caption on them, etc.)

    I wrote enough code to get it to work for a specified range, i.e. one cell, but I want it to loop down to the next cell and insert a new caption with that new title, and then do it over and over and over again until all 250 distinct titles are entered.

    Here is the code so far, below, I have it running a function, which runs a sub to get the title of the one cell.

    But now I’m stuck on how to get it to move on automatically to the next cell and run again – any tips?

    Thanks so much!




    Sub Macro123()
    Selection.InsertCaption Label:="Figure", TitleAutoText:="InsertCaption2", _
    Title:=".", "font-face:"">Selection.TypeText Text:=TitleDrop
    Selection.Style = ActiveDocument.Styles("EcoCaption")
    Selection.TypeParagraph
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.TypeParagraph
    Selection.TypeText Text:="Source: Current study, based off landings data from CDFW."
    Selection.Style = ActiveDocument.Styles("EcoSource")
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    End Sub
    -----------
    Function TitleDrop()
    GetExcelTitles
    Selection.PasteAndFormat (wdFormatPlainText)

    End Function
    -----------------

    Sub GetExcelTitles()
    Dim ObjXL As Object, xlWkBk
    Dim strTitleName As String

    On Error Resume Next
    Set ObjXL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
    MsgBox "No Excel Files are open (Excel is not running)"
    Exit Sub
    End If
    For Each xlWkBk In ObjXL.Workbooks
    If xlWkBk.Name = "130611 Figure Lists.xlsx" Then
    xlWkBk.Sheets("Figuresonly").Range("C6").Select
    xlWkBk.Sheets("Figuresonly").Range("C6").Copy
    Exit For
    End If
    Next
    Set ObjXL = Nothing

    End Sub

    Thursday, June 13, 2013 12:12 AM

Answers

  • ThistleGrave:

    Good work so far. Now you have to streamline/combine some of your work so that you can loop through cells... 

    Sub AddCaptions()
        Dim xlApp as Excel.Application
        Dim xlBk As Excel.Workbook
        Dim xlSht As Excel.Worksheet
        Dim EndRow as Excel.Range
        Dim RowCt As Long
        Dim FigCapt As String 
        
        Set xlApp = GetObject(,"Excel.Application")
        Set xlBk = xlApp.Workbooks("130611 Figure Lists.xlsx")
        Set xlSht = xlBk.Worksheets(1)
        EndRow = xlSht.Range("C1").End(xlDown).Row
        
        For RowCt = 1 to EndRow
            FigCapt = xlSht.Range("C" & RowCt).Value
            Macro123(FigCapt)
        Next RowCt
    End Sub

    That should be enough for you to adapt what you already have. Now you just need to change Macro123 as follows:

    Sub Macro123(xlCaption as String)
    Selection.InsertCaption Label:="Figure", TitleAutoText:="InsertCaption2", _
    Title:=".", "font-face:"">Selection.TypeText Text:=xlCaption
    Selection.Style = ActiveDocument.Styles("EcoCaption")
    Selection.TypeParagraph
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.TypeParagraph
    Selection.TypeText Text:="Source: Current study, based off landings data from CDFW."
    Selection.Style = ActiveDocument.Styles("EcoSource")
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    End Sub

    I hope this helps! 


    • Edited by KMickey Thursday, June 13, 2013 2:26 AM Minor Syntax Error
    • Marked as answer by thistlegrave Thursday, June 13, 2013 7:40 PM
    Thursday, June 13, 2013 2:26 AM

All replies

  • ThistleGrave:

    Good work so far. Now you have to streamline/combine some of your work so that you can loop through cells... 

    Sub AddCaptions()
        Dim xlApp as Excel.Application
        Dim xlBk As Excel.Workbook
        Dim xlSht As Excel.Worksheet
        Dim EndRow as Excel.Range
        Dim RowCt As Long
        Dim FigCapt As String 
        
        Set xlApp = GetObject(,"Excel.Application")
        Set xlBk = xlApp.Workbooks("130611 Figure Lists.xlsx")
        Set xlSht = xlBk.Worksheets(1)
        EndRow = xlSht.Range("C1").End(xlDown).Row
        
        For RowCt = 1 to EndRow
            FigCapt = xlSht.Range("C" & RowCt).Value
            Macro123(FigCapt)
        Next RowCt
    End Sub

    That should be enough for you to adapt what you already have. Now you just need to change Macro123 as follows:

    Sub Macro123(xlCaption as String)
    Selection.InsertCaption Label:="Figure", TitleAutoText:="InsertCaption2", _
    Title:=".", "font-face:"">Selection.TypeText Text:=xlCaption
    Selection.Style = ActiveDocument.Styles("EcoCaption")
    Selection.TypeParagraph
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.TypeParagraph
    Selection.TypeText Text:="Source: Current study, based off landings data from CDFW."
    Selection.Style = ActiveDocument.Styles("EcoSource")
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    End Sub

    I hope this helps! 


    • Edited by KMickey Thursday, June 13, 2013 2:26 AM Minor Syntax Error
    • Marked as answer by thistlegrave Thursday, June 13, 2013 7:40 PM
    Thursday, June 13, 2013 2:26 AM
  • I would also add, that to learn about how to move down a cell in a table record a macro. You can't record the loop, but you can record most things. Takes you a long way, but as KMickey has shown code can be tidied, especially recorded code!

    Rod Gill

    The one and only Project VBA Book

    Rod Gill Project Management

    Thursday, June 13, 2013 8:07 AM
  • That makes sense but on this line:

    EndRow = xlSht.Range("C1:C230").Row

    It says Run-time error '91':

    Object variable or With Block variable not set...

    ?

    Thursday, June 13, 2013 7:10 PM
  • Thanks much - here's what I ended up with that worked!

    Sub GetExcelTitles()
    Dim ObjXL As Object, xlWkBk
    Dim RowCt As Long

    Set ObjXL = GetObject(, "Excel.Application")

    For Each xlWkBk In ObjXL.Workbooks
    If xlWkBk.Name = "130611 Figure Lists.xlsx" Then
        
       For RowCt = 2 To 230
        xlWkBk.Sheets("Figuresonly").Range("C" & RowCt).Copy
        Macro123
       Next RowCt

    End If
    Exit For

    Set ObjXL = Nothing
    Next

    End Sub
    ------------------
    Sub Macro123()
    Selection.InsertCaption Label:="Figure", TitleAutoText:="InsertCaption2", _
            Title:=".", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
    Selection.TypeText Text:=TitleDrop
    Selection.Style = ActiveDocument.Styles("EcoCaption")
    Selection.TypeParagraph
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.TypeParagraph
    Selection.TypeText Text:="Source: Current study, based off landings data from CDFW."
    Selection.Style = ActiveDocument.Styles("EcoSource")
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    End Sub
    --------------
    Function TitleDrop()

    Selection.PasteAndFormat (wdFormatPlainText)

    End Function

    Thursday, June 13, 2013 7:36 PM
  • I got it to work - and I tried to post up what ended up working, but am I not allowed to do that? It said it was flagged and now I don't see it. (updated: It showed up above, I see it!) Sorry I'm nearly a VBA virgin, just gettin' started.

    But basically thank you, what you wrote helped me with the RowCt looping even though I got that error msg about the EndRow. I reordered the subs so that GetExcelTitles was first and called upon Macro123 within the loop like you suggested, which was super effective. Thank you!

    And yes, Rod Gill, definitely I could tidy up my code - just learning and that means lots of recording for now! :) Thanks all!


    Thursday, June 13, 2013 7:40 PM
  • You must not have set the xlSht object to a valid sheet. But even if you had, EndRow would have been 1 - you actually would want this,once you have set xlSht properly:

    Set xlSht = ActiveSheet

    EndRow = xlSht.Range("C1:C230").Rows.Count

    Since you hard coded the range, that would always have been 230

    Better

    EndRow = xlSht.Cells(Rows.Count,3).End(xlUp).Row


    Thursday, June 13, 2013 8:23 PM
  • The first few months of learning are kind of an uphill battle, after that, it gets easier and easier. Good work for an early go at it; working with 2 applications is a little different. That should really get you into the mode of an object-oriented approach! 
    Thursday, June 13, 2013 8:28 PM