i use vba in wordfile A to add a word file B to the end of file A.
File A has a header(Kopfzeile), file B does not have this. When B is added in the end of A, all the headers in A are gone, but what i want is that the header of A is also on the added content of B
used code:
Set Doc_A = Documents.Open(path_A)
Doc_A.Range.InsertBreak (wdSectionBreakNextPage)
Selection.Collapse Direction:=wdCollapseEnd
Selection.InsertFile FileName:=Path_B
You need to unlink the header(s) in the new section. For example:
Set Doc_A = Documents.Open(path_A)
Doc_A.Range.InsertBreak (wdSectionBreakNextPage)
With Doc_A.Sections.Last
.Headers(wdHeaderFooterPrimary).LinkToPrevious = False
.Range.Paragraphs.Last.Range.InsertFile FileName:=Path_B
End With
Related
In MS Word, you can create hyperlinks to a "Place in this document" so that a link takes you someplace else in the same Word file. However, if you change headers or move things around these links will sometimes break. I want to write some VBA to check for broken links.
With VBA, you can list each hyperlink subaddress using the code below:
Sub CheckLinks()
Set doc = ActiveDocument
Dim i
For i = 1 To doc.Hyperlinks.Count
Debug.Print doc.Hyperlinks(i).SubAddress
Next
End Sub
The output from the code above also matches what is shown in the field codes for the hyperlink.
However, I'm not really clear on how to verify if the SubAddress is correct. For example, an excerpt from the program output shows this:
_Find_a_Staff_1
_Edit_Organization_Settings_2
_Set_the_Staff
_Find_a_Staff_1
But there's no obvious way to tell what the "correct" suffix should be for a given heading. Any thoughts on how to check if these are valid?
Is there a way to get the list of all valid subaddresses for the headings in the document?
The code below will list the hyperlinks where the corresponding bookmark does not exist in the document. (Note that it only detects missing links, not links that go to the wrong place.)
Sub CheckLinks()
Dim doc As Document
Set doc = ActiveDocument
Dim i, j
Dim found As Boolean
For i = 1 To doc.Hyperlinks.Count
found = False
For j = 1 To doc.Bookmarks.Count
If doc.Range.Bookmarks(j).Name = doc.Hyperlinks(i).SubAddress Then
found = True
End If
Next
If found = False Then
Debug.Print doc.Hyperlinks(i).SubAddress
End If
Next
End Sub
I am giving my required Excel Template here. As my present scenario this excel will be stored in a fix path. But CSV will generate everyday.
My vb script should execute everyday to collect data from csv and write into this Excel , but small customization needed.
Here First 3 rows are Fixed Header, I need to convert csv and write values in excel from 4th row. but its obvious we have old data there. so it should delete 4th row to 7th row and put csv value as per required place. With proper border also.
Now tell me is it possible to modify my vbs to get this type of output?
to run the script like below ...
MyScript.vbs : which needs two argument to execute
cscript C:\Test\MyScript.vbs \\C:\Test\Sample.CSV \\C:\Test\Sample.xlsx
Original script is below. but I want to view like below screenshot.
srccsvfile = Wscript.Arguments(0)
tgtxlsfile = Wscript.Arguments(1)
'Create Spreadsheet
'Look for an existing Excel instance.
On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(, "Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then '> 0
Set objExcel = CreateObject("Excel.Application")
End If
objExcel.Visible = False
objExcel.DisplayAlerts = False
'Import CSV into Spreadsheet
Set objWorkbook = objExcel.Workbooks.Open(srccsvfile)
Set objWorksheet1 = objWorkbook.Worksheets(1)
'Adjust width of columns
Set objRange = objWorksheet1.UsedRange
objRange.EntireColumn.Autofit()
'This code could be used to AutoFit a select number of columns
'For intColumns = 1 To 17
' objExcel.Columns(intColumns).AutoFit()
'Next
'Make Headings Bold
objExcel.Rows(1).Font.Bold = True
'Freeze header row
With objExcel.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
objExcel.ActiveWindow.FreezePanes = True
'Add Data Filters to Heading Row
objExcel.Rows(1).AutoFilter
'set header row gray
objExcel.Rows(1).Interior.ColorIndex = 15
'-0.249977111117893
aList=Array("NOT ", "NO ", "NONE", "!")
For each item in aList
For Each c In objWorksheet1.UsedRange
If InStr(1, c.Value, item) > 0 Then
c.Interior.ColorIndex = 6
End If
Next
next
'Save Spreadsheet, 51 = Excel 2007-2010
objWorksheet1.SaveAs tgtxlsfile, 51
'Release Lock on Spreadsheet
objExcel.Quit()
Set objWorksheet1 = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
Header and Legend should be Fixed as screenshot.
But there can be alternate way also. If I can get some modified vb script which can create Header like the above screenshot (i.e. merge cell, border, freeze, remove gridlines) and add legend at the bottom, then I don't need to write into existing excel everyday. All-time when vbs executes it should replace old excel (if exist) with this proper format.
record a macro of creating the header and legend. then edit the code for clean up all the .Select ... Selection statements. ... in your code that you posted, you can autofit all the columns with one command by using one of these
ActiveSheet.Columns("A:Q").AutoFit
ActiveSheet.Range(Columns(1), Columns(17)).AutoFit
ID Employee Date
1234 me 11/03/2015
9999 U 11/03/2015
1111 Us 11/03/2015
Hi,
I have the above table in excel that is populated when a user completes a userform and clicks a 'Save' Button. Once they have saved an 'Export' button is enabled and the user can export the last record (row) submitted by the user form to a word template in the relevant locations on the template. I have created bookmarks in the attached word template for ID,Employee and Date and would like the data to be exported to these locations.
I've written the following code on the 'Export' button but I can't seem to get the export to work. the code runs up until the template is opened but the posting of the data to the bookmarks causes an error.
Sub PDFExportRow()
Dim WRD As Object, DOC As Object, ac As Long
On Error Resume Next
Set WRD = CreateObject("Word.Application")
If Err.Number <> 0 Then
Set WRD = CreateObject("Word.Application")
End If
On Error GoTo 0
Set DOC = WRD.Documents.Open("C:\RC_QA_TEST\Template\QA_REPORT.dotm")
WRD.Visible = True
ac = ActiveCell.Row
With DOC
.FormFields("ID").Result = Cells(ac, "A")
.FormFields("Employee").Result = Cells(ac, "B")
.FormFields("Date").Result = Cells(ac, "C")
End With
'set active printer to one you use here
WRD.ActivePrinter = "CutePDF Writer"
'print document
DOC.PrintOut
'close document without saving
DOC.Close False
'close application
WRD.Quit
Set WRD = Nothing
Set DOC = Nothing
End Sub
Any help on this is greatly appreciated.
If the code is having errors starting with the DOC.FormFields part, then I think the problem is that you haven't actually used Form Fields, you have used bookmarks, so you need to use the appropriate methods.
Try this:
With DOC
.Bookmarks("ID").Range.Text = Cells(ac, "A")
.Bookmarks("Employee").Range.Text = Cells(ac, "B")
.Bookmarks("Date").Range.Text = Cells(ac, "C")
End With
Note that once you update the text in a bookmark, the bookmark is removed from the document. Since you are closing the document without saving it, when you reopen, the bookmark will be there again, but you would need to reset the bookmark if you were to save the word doc, or keep it open and try to replace the text again.
I would like to change title of my header based on a drop down by using macro help.
I am trying to find all the items in my word file by below code but it seems that the text box in my header is not coming in ActiveDocument.ContentControls list. would you mind help me to solve my problem.
My "test" message never appear.
For Each oCC In ActiveDocument.ContentControls
If oCC.Tag = "CB_DOC_TYP" Then
MsgBox "doc Type"
For Each oDD In ActiveDocument.ContentControls
If oDD.Tag = "TB_Header_Titel" Then
oDD.SetPlaceholderText , , oCC.Title
MsgBox "test"
End If
Next oDD
End If
End If
Header is different part of the document. When calling ActiveDocument.ContentControl you search by default in wdMainTextStory section. To get your content control which is in header try one of the references:
ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ContentControls
or
ActiveDocument.StoryRanges(wdEvenPagesHeaderStory).ContentControls
or
ActiveDocument.StoryRanges(wdFirstPageHeaderStory).ContentControls
You can also loop through all document story ranges in this way:
Dim SR As Object
For Each SR In ActiveDocument.StoryRanges
'your macro here
'....
Next
I need to generate bookmarks in Word 2010 programmatically, with the header name as the bookmark name.
I have the following code which makes a word a bookmark, but the bookmark name remains the same as the string Heading 1 is only available in the name variable:
Sub bookmarking()
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:=" Heading 1"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
End Sub
Instead of the Heading 1 in the name variable, I want content from the clipboard. Please help me replace that Heading 1 with clipboard content.
Use a DataObject from the Microsoft Forms 2.0 Object Library:
Private Function GetClipboardData()
Dim objDataObject As MSForms.DataObject ''need to add reference in Tools |References
Set objDataObject = New MSForms.DataObject
objDataObject.GetFromClipboard
On Error Resume Next
GetClipboardData = objDataObject.GetText
If Err.Number = -2147221404 Then
MsgBox "Error: current clipboard data is either empty or is not text. Clibpoard must contain text."
End If
End Function
Then, back your main code, have the bookmark name be this clipboard data:
...
.Add Range:=Selection.Range, Name:=GetClipboardData()
...
Is this a good start for you? There are other ways which may be more robust depending on your needs. However this should serve as good proof-of-concept.