#1
|
|||
|
|||
Word VBA help to copy cell info from Excel to Word
Hi all, I am trying to write a macro in WORD 2007 which will:
- open the Open File Dialogue for the user to select an EXCEL file - select a range of data (one column, but a variety of rows) - copy the data to the clipboard - switch back to WORD It has to be run from Word as the Excel sheets are already in use by a large number of users, have been populated with varying data from a large number of sites and depending on the Users profile and preferences could be stored in a variety of locations with varying file names (hence the open file dialogue). It would be a major headache to change every single excel file to add this macro whereas the Word document I'm creating is new and will eventually be sent to all. The excel sheet is used for collecting data (monitor number, location, info collected from site visits) and not intended for printing (main objective to populate pre formatted graphs). The Word document will create a BLANK form with only the monitor number and location filled in on a nicely presented table for non-laptop owners to hand write the findings on which can be transferred to the sheet at a later date. The reason I'm using Word is that I have a little more control over the formatting of the page layout, cell borders etc (yeah, I know!) and there will be other word processed client specific text inserted between tables with bookmarks and Quick Parts . Once the data is on the clipboard and the window has switched focus to Word I already have the macro set up that will select a range, paste and format as desired but would need to know how to switch back to excel to grab the next range and so on... Thanks in advance |
#2
|
||||
|
||||
If you are going to have users manually selecting ranges as part of the process, you need to do this from Excel. You could create the code in an Excel add-in and distribute that instead.
However it could be practical to run it from Word, if the ranges were known in advance, but from your description that does not appear to be the case. I would think the only practical solution for working in Word would be to read the selected worksheet into a Userform list box, then allow the user to pick the records to be transferred to the document. The formatting would then have to be applied in Word.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Thanks for the reply. The ranges in excel are not to be chosen by the user, they are predefined and constant. I already have the part of the macro that will select the relevant table in word, paste the contents of the clipboard and format it.... Just don't know how to get it to the clipboard using the macro.
|
#4
|
||||
|
||||
Can you list the ranges in question and the worksheet name (or index) and I will have a look at it for you. Better still attach a workbook sample (you can change any sensitive information) and the document so that we can see what you are doing.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
|||
|
|||
I'm out and about today but will be office based later on, I'll post some examples later on. Thanks
|
#6
|
|||
|
|||
Quote:
I would very much like to know the code (FROM WORD) to open the "open file" dialogue in Excel, to select a specified range in excel, copy it to the clipboard, switch back to the open Word document (also the code to switch back to the excel document), hopefully from there I can mix and match with what I already have (some macros stored in the document): Select the range to paste over in WORD: Sub SelectLocationT1() ' ' SelectLocationT1 Macro ' ' Dim myCells As Range With ActiveDocument Set myCells = ActiveDocument.Range(Start:=ActiveDocument.Tables( 1).Cell(7, 2).Range.Start, _ End:=ActiveDocument.Tables(1).Cell(31, 2).Range.End) myCells.Select End With End Sub (i can modify anything you supply to select a different table) To paste what is already on the clipboard in the right space after running the above: Sub PasteNumbers() ' ' PasteNumbers Macro ' ' Selection.PasteSpecial DataType:=wdPasteHTML Selection.Font.Name = "Trebuchet MS" Selection.Font.size = 10 Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter End Sub (Again, I can modify to select different tables, columns etc) The 1st range i need to copy from excel is A7:A31 for the numbers column, B7:B31 for the locations. Not a problem to work with A7:B31 as I can run a small macro at the end to format the table in Word as intended. If you are able to provide the code to do the above (open and choose an excel file that could be stored anywhere and named anything, select one of the tabs in the sheet (might need to assume it could have been saved with the wrong tab to the front), select the range listed and copy to the clipboard, then switch to word to allow me to mix in the above code... sounds simple huh? (if only). I can modify the code to then choose range A32:B56 and so on (blocks of 25) and paste in the appropriate table (ActiveDocument.Tables(1), ActiveDocument.Tables(3) etc) Thank you |
#7
|
|||
|
|||
This code is similar to what you are trying to do and is something I crafted together with lots of help from here.
Essentially, this asks the user for the excel file they wish to use, and then updates all of the OLE Links in the document. Note, I have what looks like strange info for a search and file and replace in the beginning. It was the only way I could find to get this to work withe Office/Word 2013 and the way OLE links seem to behave. And i stripped out a few things that was writing some values to Doc Properties. Code:
Sub ChangeFileLinks() Dim f As Object Dim i, x, fieldCount As Long Dim iRet As Integer Dim Message As String Dim OldPath As String Dim OldFile As String Dim NewPath, WPPath As String Dim NewFile As String Dim sFind As String Dim SReplace As String Dim ofld As Field On Error GoTo LinkError iRet = MsgBox("Link Report to New Excel File?", vbYesNo) If iRet = vbNo Then Exit Sub Set f = Application.FileDialog(3) f.Title = "Please Select A New File" f.AllowMultiSelect = False f.Filters.Clear f.Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm, *.xlsx" 'Limit to Excel Files Only If f.Show Then For i = 1 To f.SelectedItems.Count 'Get the File Path Only NewPath = f.InitialFileName WPPath = f.InitialFileName NewPath = Replace(NewPath, "\", "\\") 'Get the FileName only. Uses Public FileName Function Below NewFile = FileName(f.SelectedItems(i)) 'MsgBox "The New File Path is: " & NewPath 'MsgBox "The FileName Only is: " & Filename(f.SelectedItems(i)) Next Else 'user clicked cancel Exit Sub End If 'Confirm User wishes to change the file Message = "Please confirm you would like to link this report to the following file:" & vbNewLine & vbNewLine Message = Message & f.InitialFileName & NewFile & vbNewLine & vbNewLine Message = Message & "Are you sure you would like to continue?" iRet = MsgBox(Message, vbYesNo) If iRet = vbNo Then Exit Sub Call MsgBox("Please allow approximately 1 minute to link all charts", vbOKOnly) With ActiveDocument 'First Fix FilePath in case file was emailed ActiveWindow.View.ShowFieldCodes = True 'Field Code On For Each ofld In ActiveDocument.Fields If ofld.Type = wdFieldLink Then If InStr(1, ofld.Code, ".xlsm!") > 0 Then sFind = ".xlsm!" SReplace = ".xlsm"" """ Call FindAndReplace(sFind, SReplace) sFind = """"" \p" SReplace = "\p" Call FindAndReplace(sFind, SReplace) Exit For End If End If Next ofld ActiveWindow.View.ShowFieldCodes = False 'Field Code Off fieldCount = .Fields.Count For x = 1 To fieldCount With .Fields(x) 'Debug.Print .Type If .Type = 56 Then 'Get The Existing FilePath and File Name from the Link Sources OldPath = .LinkFormat.SourcePath & "\" OldPath = Replace(OldPath, "\", "\\") 'MsgBox "The Existing FilePath is: " & OldPath OldFile = .LinkFormat.SourceName 'MsgBox "The Existing File Name is: " & .LinkFormat.SourceName 'Replace the FilePath ' Replace the link to the external file .Code.Text = Replace(.Code.Text, OldPath, NewPath) '.LinkFormat.SourceFullName = NewPath 'Replace the ExtraFileName for the Graphs only '.LinkFormat.SourceName = NewFile .Code.Text = Replace(.Code.Text, OldFile, NewFile) '.Update End If End With Next x .Fields.Update End With Call MsgBox("All Links Succesfully Updated!", vbOKOnly) Exit Sub LinkError: Select Case Err.Number Case 5391 'could not find associated Range Name MsgBox "Could not find the associated Excel Range Name " & _ "for one or more links in this document. " & _ "Please be sure that you have selected a valid " & _ "workpaper file.", vbCritical Case Else MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical End Select End Sub Public Function FileName(ByVal strPath As String) As String If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then FileName = FileName(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1) End If End Function Sub FindAndReplace(sFind As String, SReplace As String) Dim rngStory As Range For Each rngStory In ActiveDocument.StoryRanges With rngStory.Find .Text = sFind .Replacement.Text = SReplace .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End With Next rngStory End Sub |
#8
|
||||
|
||||
The following does what you asked
Code:
Option Explicit Sub ProcessTable() Dim xlApp As Object Dim xlBook As Object Dim xlSheet As Object Dim xlRange As Object Dim oTable As Table Dim oRng As Range Dim oDoc As Document Dim fDialog As FileDialog Dim strWorkbookname As String 'Check document is valid If ActiveDocument.Tables.Count = 0 Then GoTo err_handler If ActiveDocument.Tables(1).Rows.Count < 31 Then GoTo err_handler If ActiveDocument.Tables(1).Columns.Count < 2 Then GoTo err_handler 'Select the workbook Set fDialog = Application.FileDialog(msoFileDialogFilePicker) With fDialog .Title = "Select the workbook to process" .AllowMultiSelect = False .Filters.Clear .Filters.Add "Excel Workbooks", "*.xls* " If .Show <> -1 Then MsgBox "Cancelled By User", , _ "List Folder Contents" Exit Sub End If strWorkbookname = .SelectedItems(1) End With On Error Resume Next Set xlApp = GetObject(, "Excel.Application") If Err Then Set xlApp = CreateObject("Excel.Application") End If On Error GoTo lbl_Exit 'Open the workbook and set the required range Set xlBook = xlApp.Workbooks.Open(Filename:=strWorkbookname) Set xlSheet = xlBook.Sheets("Internal") Set xlRange = xlSheet.Range("A7:B31") 'Copy the range xlRange.Copy 'Close the workbook xlBook.Close SaveChanges:=False 'Set the document to process and the table range Set oDoc = ActiveDocument Set oTable = oDoc.Tables(1) Set oRng = oDoc.Range(Start:=oTable.Cell(7, 1).Range.Start, _ End:=oTable.Cell(31, 2).Range.End) 'Paste and format the data in the table With oRng .Paste .Font.name = "Trebuchet MS" .Font.Size = 10 .ParagraphFormat.Alignment = wdAlignParagraphCenter .Cells.VerticalAlignment = wdCellAlignVerticalCenter End With 'CleanUp lbl_Exit: Set xlApp = Nothing Set xlBook = Nothing Set xlSheet = Nothing Set xlRange = Nothing Set oDoc = Nothing Set oTable = Nothing Set oRng = Nothing Exit Sub err_handler: MsgBox "The activedocument does not appear to be the correct document?" GoTo lbl_Exit End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
Tags |
macro, word 2007 |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro to copy cell info to multiple documents | Patrick Innes | Word VBA | 2 | 02-18-2015 08:38 PM |
link conditional info in word based on excel list | stijnvanhoof | Mail Merge | 1 | 11-13-2012 01:55 PM |
Open Word w Excel & fill Word textboxes w info from Excel fields runtime error 4248 | Joe Patrick | Word VBA | 2 | 01-30-2012 07:23 AM |
Merge excel info into word letter. | curatorfm | Mail Merge | 1 | 03-20-2011 04:26 AM |
Copy all comments & cell contents (i.e. data) to word? | IanM | Excel | 0 | 07-03-2010 11:14 PM |