so I started with VBA yesterday and keep running into walls. In the long run, I'm trying to create a Word template that checks if it's still up to date or if it's time for revision.
Right now I want to store a date from the document in a variable. I couldn't find a method to directly read out something in date format so now I'm using Selection.Text and CDate but that gives me an error (incompatible types) because my selection seems to contain another character or marker ([]). I'm guessing it has something to do with the fact that the bookmark is on a cell of a table within my Word document because it works fine in the running text.
I'm doing this in a table because this way I can be sure where the date in question is in the document and because I'm not sure how to reset the bookmark after the date has been changed.
I tried to limit the selection to the date by using
Selection.SetRange Start:=0, End:=8 (and a few variations) but that selects only a space and the ominous marker (or another cell entirely).
I have also looked into Ranges but as far as I can tell it doesn't solve my problem and I can't really use them yet, so for now I'm sticking to selection.
This is my code:
Sub ChangeNextRev()
Dim nextRevision As Date
Dim RevisionDate As Date
Dim temp As String
'Selection.GoTo what:=wdGoToBookmark, Name:="lastRevision"
'Selection.SetRange Start:=0, End:=8
'Selection.GoTo what:=wdGoToBookmark, Name:="lastRevision"
Selection.GoTo what:=wdGoToBookmark, Name:="runningText"
temp = Selection.Text
RevisionDate = CDate(temp)
Debug.Print (RevisionDate)
nextRevision = RevisionDate + 14
With Selection
.GoTo what:=wdGoToBookmark, Name:="nextRevision"
.TypeText Text:=Format$(nextRevision, "DD.MM.YY")
End With
End Sub
Can someone point me in the right direction? How can I only select the date I need? Is there an easier way besides a table to control where the date is entered or to find it afterwards?
Any help on where I'm going wrong would be greatly appreciated :)
Your guess about the table cell is correct, but you can work around that by trimming off the extraneous character(s). End-of-cell is a Chr(13) + Chr(7) (Word paragraph plus cell structure marker).
There are various ways to code this, but I have the following function at-hand:
'Your code, relevant lines, slightly altered:
Selection.GoTo what:=wdGoToBookmark, Name:="runningText"
temp = TrimCellText(Selection.Text)
RevisionDate = CDate(temp)
Debug.Print (RevisionDate)
'Function to return string without end-of-cell characters
Function TrimCellText(s As String) As String
Do While Len(s) > 0 And (Right(s, 1) = Chr(13) Or Right(s, 1) = Chr(7))
s = Left(s, Len(s) - 1)
Loop
TrimCellText = s
End Function
If the date is the only content in the cell you could use:
Dim Dt As Date
Dt = CDate(Replace(Split(ActiveDocument.Bookmarks("runningText").Range.Text, vbCr)(0), ".", "/"))
You could try something along these lines
Sub test()
Dim d As Date
d = CDate(Replace(ThisDocument.GoTo(wdGoToBookmark, , , "TEST_BM").Text, ".", "/"))
Debug.Print d
End Sub
Related
I'm trying to make a VBA script that will take all the headings in a document and make a table of contents out of them, with hyperlinks to each of the headings. The headings are all found, parsed and all the hyperlinks are made, however they don't correctly reach their destination which is a place within the document. The default 'create hyperlink to Place in this document' code looks like this:
Selection.Range.Hyperlinks(1).Range.Fields(1).Result.Select
Selection.Range.Hyperlinks(1).Delete
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
SubAddress:="_Test_Heading"
Selection.Collapse Direction:=wdCollapseEnd
This is the code that you would get if you recorded a macro while using the 'Edit hyperlink' window.
Edit hyperlink window
The address field where normally there would be a URL is empty, while the subaddress field is filled by the name of the header with underscores.
I think the problem is that Word defaults to 'Existing file or web page' rather than 'Place in this document', even if 'Place in this document' were specified prior. If I switch the mode of a link to 'Place in this document' without changing the subaddress or anything else, it works - but having to go and do that for each link defeats the purpose of the script. I've been looking all over for a way to express 'Place in this document' in VBA but haven't found anything. Tried bookmarks as an alternative and that didn't work either. Any help would be appreciated.
I found a workaround using cross-referencing. In case it helps anyone in the future:
Private Function GetLevel(strItem As String) As Integer
Dim strTemp As String
Dim strOriginal As String
Dim longDiff As Integer
strOriginal = RTrim$(strItem)
strTemp = LTrim$(strOriginal)
longDiff = Len(strOriginal) - Len(strTemp)
GetLevel = (longDiff / 2) + 1
End Function
Sub TableofContents()
Dim i As Integer
Dim AllHeadings As Variant
AllHeadings = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
Selection.HomeKey Unit:=wdStory
Selection.HomeKey Unit:=wdLine
For i = LBound(AllHeadings) To UBound(AllHeadings)
strtext = Trim$(AllHeadings(i))
Level = GetLevel(CStr(AllHeadings(i)))
If Level = 2 Then
Selection.InsertCrossReference ReferenceType:="Heading", ReferenceKind:= _
wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True, _
IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
Selection.TypeParagraph
End If
Next
End sub
The first function gets the level of the heading.
The second part moves to the top of the document and starts inserting cross-references to the headings that I want (in this case I want it to be = 2).
I'm trying to manipulate some text from a MS Word document that includes hyperlinks. However, I'm tripping up at understanding exactly what Range.Start and Range.End are returning.
I banged a few random words into an empty document, and added some hyperlinks. Then wrote the following macro...
Sub ExtractHyperlinks()
Dim rHyperlink As Range
Dim rEverything As Range
Dim wdHyperlink As Hyperlink
For Each wdHyperlink In ActiveDocument.Hyperlinks
Set rHyperlink = wdHyperlink.Range
Set rEverything = ActiveDocument.Range
rEverything.TextRetrievalMode.IncludeFieldCodes = True
Debug.Print "#" & Mid(rEverything.Text, rHyperlink.Start, rHyperlink.End - rHyperlink.Start) & "#" & vbCrLf
Next
End Sub
However, the output between the #s does not quite match up with the hyperlinks, and is more than a character or two out. So if the .Start and .End do not return char positions, what do they return?
This is a bit of a simplification but it's because rEverything counts everything before the hyperlink, then all the characters in the hyperlink field code (including 1 character for each of the opening and closing field code braces), then all the characters in the hyperlink field result, then all the characters after the field.
However, the character count in the range (e.g. rEverything.Characters.Count or len(rEverything)) only includes the field result if TextRetrievalMode.IncludeFieldCodes is set to False and only includes the field code if TextRetrievalMode.IncludeFieldCodes is set to True.
So the character count is always smaller than the range.End-range.Start.
In this case if you change your Debug expression to something like
Debug.Print "#" & Mid(rEverything.Text, rHyperlink.Start, rHyperlink.End - rHyperlink.Start - (rEverything.End - rEverything.Start - 1 - Len(rEverything))) & "#" & vbCrLf
you may see results more along the lines you expect.
Another way to visualise what is going on is as follows:
Create a very short document with a piece of text followed by a short hyperlink field with short result, followed by a piece of text. Put the following code in a module:
Sub Select1()
Dim i as long
With ActiveDocument
For i = .Range.Start to .Range.End
.Range(i,i).Select
Next
End With
End Sub
Insert a breakpoint on the "Next" line.
Then run the code once with the field codes displayed and once with the field results displayed. You should see the progress of the selection "pause" either at the beginning or the end of the field, as the Select keeps "selecting" something that you cannot actually see.
Range.Start returns the character position from the beginning of the document to the start of the range; Range.End to the end of the range.
BUT everything visible as characters are not the only things that get counted, and therein lies the problem.
Examples of "hidden" things that are counted, but not visible:
"control characters" associated with content controls
"control characters" associated with fields (which also means hyperlinks), which can be seen if field result is toggled to field code display using Alt+F9
table structures (ANSI 07 and ANSI 13)
text with the font formatting "hidden"
For this reason, using Range.Start and Range.End to get a "real" position in the document is neither reliable nor recommended. The properties are useful, for example, to set the position of one range relative to the position of another.
You can get a somewhat more accurate result using the Range.TextRetrievalMode boolean properties IncludeHiddenText and IncludeFieldCodes. But these don't affect the structural elements involved with content controls and tables.
Thank you both so much for pointing out this approach was doomed but that I could still use .Start/.End for relative positions. What I was ultimately trying to do was turn a passed paragraph into HTML, with the hyperlinks.
I'll post what worked here in case anyone else has a use for it.
Function ExtractHyperlinks(rParagraph As Range) As String
Dim rHyperlink As Range
Dim wdHyperlink As Hyperlink
Dim iCaretHold As Integer, iCaretMove As Integer, rCaret As Range
Dim s As String
iCaretHold = 1
iCaretMove = 1
For Each wdHyperlink In rParagraph.Hyperlinks
Set rHyperlink = wdHyperlink.Range
Do
Set rCaret = ActiveDocument.Range(rParagraph.Characters(iCaretMove).Start, rParagraph.Characters(iCaretMove).End)
If RangeContains(rHyperlink, rCaret) Then
s = s & Mid(rParagraph.Text, iCaretHold, iCaretMove - iCaretHold) & "" & IIf(wdHyperlink.TextToDisplay <> "", wdHyperlink.TextToDisplay, wdHyperlink.Address) & ""
iCaretHold = iCaretMove + Len(wdHyperlink.TextToDisplay)
iCaretMove = iCaretHold
Exit Do
Else
iCaretMove = iCaretMove + 1
End If
Loop Until iCaretMove > Len(rParagraph.Text)
Next
If iCaretMove < Len(rParagraph.Text) Then
s = s & Mid(rParagraph.Text, iCaretMove)
End If
ExtractHyperlinks = "<p>" & s & "</p>"
End Function
Function RangeContains(rParent As Range, rChild As Range) As Boolean
If rChild.Start >= rParent.Start And rChild.End <= rParent.End Then
RangeContains = True
Else
RangeContains = False
End If
End Function
I have a VBA script that opens up a bunch of CSV files, and compiles them into one summary report.
However, I'm having a problem where it reads in UK style dates (dd/mm/yyyy), then interprets them as US-style dates when it makes the copy, before display them as UK-style dates again!
So 4th of July in original sheet becomes 7th of April in the summary sheet - verified by changing cell format to display month name.
This is odd, as when you open up the CSV file in Excel, it correctly interprets the UK style date.
Copy is made using code like this
SummarySheet.Cells(Y,X).value = CSVSheet.Cells(W,Z).value
What is going on here?
You did not post the code as to how you are opening your CSV files -- that is the critical area. The dates need to be parsed properly BEFORE being entered on the worksheet. The following code will selects and then opens a file that has UK style dates in a single column, and properly parse them. You will need to adapt it to your particular requirements.
The FieldInfo argument is what does the work. The formatting of the Excel worksheet is "for show" so you can see an unambiguous date.
Option Explicit
Sub OpenUKcsv()
Dim sFile As String
Dim WB As Workbook
Dim WS As Worksheet
sFile = Application.GetOpenFilename()
Workbooks.OpenText Filename:=sFile, DataType:=xlDelimited, comma:=True, other:=False, _
fieldinfo:=Array(1, 4)
Set WB = ActiveWorkbook
Set WS = ActiveSheet
With WS.Columns(1)
.NumberFormat = "dd-mmm-yyyy"
.EntireColumn.AutoFit
End With
End Sub
You could use .Text (text displayed in Excel cell) or .Value2 (value without formatting) instead of .Value (value with formatting).
But I strongly suggest that you set the format of the cells that you use to what you expect to have at the end with .NumberFormat = "mm/dd/yyyy"
Or you could use CDate function :
SummarySheet.Cells(Y,X).value = CDate(CSVSheet.Cells(W,Z).value)
Or use an UDF with DateSerial :
Sub test_CMaster()
MsgBox ParseDate("4/7/15") & vbCrLf & CDate("4/7/15")
End Sub
Function ParseDate(ByVal DateInCell As String, Optional Separator As String = "/") As Date
Dim D() As String
D = Split(DateInCell, Separator)
ParseDate = DateSerial(D(UBound(D)), D(1), D(0))
End Function
Try using the Workbooks.OpenText() method instead and set the Local flag to True
Set csvWB = Workbooks.OpenText(Filename:=myCSVfile, Local:=True)
Here is the MSDN article on this method which says for the Local setting:
Specify True if regional settings of the machine should be used for separators, numbers and data formatting.
Maybe you can convert the CSV files to show dates as numbers, ie. 10th Nov 15 will show as 42318. Or add a separate column where B1 is =DATEVALUE(A1) and work with that.
When you create the summary report, import the numbers and convert them to date using CDate and Format. Something like this:
Sub test()
Range("A2:A4").NumberFormat = "m/d/yyyy"
Range("A2").Value = Format(CDate(Range("A1").Value), "dd.mm.yyyy")
Range("A3").Value = Format(CDate(Range("A1").Value), "mm.dd.yyyy")
Range("A4").Value = Format(CDate(Range("A1").Value), "Long Date")
End Sub
EDIT:
For better formatting (no need for NumberFormat, I think it will use your regional settings right away) and auto-setting the cell format to date-type, use this:
Sub test()
Dim sDate As Date
sDate = CDate(Range("A1").Value)
Range("A2").Value = DateSerial(Year(sDate), Month(sDate), Day(sDate))
End Sub
Result:
References:
http://www.techonthenet.com/excel/formulas/format_date.php
http://www.techonthenet.com/excel/formulas/cdate.php
OP Update:
Thanks for the code KazJaw, it prompted me to change the approach I am trying to tackle the problem with. This is my current code:
Sub Method3()
Dim intFieldCount As Integer
Dim i As Integer
Dim vSt1 As String
intFieldCount = ActiveDocument.Fields.Count
For i = 1 To intFieldCount
ActiveDocument.Fields(i).Select 'selects the first field in the doc
Selection.Expand
vSt1 = Selection.Fields(1).Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
ActiveDocument.Bookmarks(vSt1).Select 'Selects the current crossreference in the ref list
Next i
End Sub
Ok the so the Code currently finds the first field in the document, reads its field code and then jumps to the location in the document to mimic a CTRL+Click.
However, It does this for all types of fields Bookmarks, endnotes, figures, tables etc. I only want to find Reference fields. I thought I could deduce this from the field code but it turns out figures and bookmarks use the same field code layout ie.
A Reference/Boookmark has a field code {REF_REF4123123214\h}
A Figure cross ref has the field code {REF_REF407133655\h}
Is there an effective way to get VBA to distinguish between the two? I was thinking as reference fields in the document are written as (Reference 1) I could find the field and then string compare the word on the left to see if it says "Reference".
I was thinking of using the MoveLeft Method to do this
Selection.MoveLeft
But I can't work out how to move left 1 word from the current selection and select that word instead to do the strcomp
Or perhaps I can check the field type? with...
If Selection.Type = wdFieldRef Then
Do Something
End If
But I am not sure which "Type" i should be looking for.
Any advice is appreciated
All REF fields "reference" bookmarks. Word sets bookmarks on all objects that get a reference for a REF field: figures, headings, etc. There's no way to distinguish from the content of the field what's at the other end. You need to "inspect" that target, which you can do without actually selecting it. For example, you could check whether the first six letters are "Figure".
The code you have is inefficient - there's no need to use the Selection object to get the field code. The following is more efficient:
Sub Method3()
Dim fld As Word.Field
Dim rng as Word.Range
Dim vSt1 As String
ForEach fld in ActiveDocument.Fields
vSt1 = fld.Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
Set rng = ActiveDocument.Bookmarks(vSt1).Range
If Left(rng.Text, 6) <> "Figure" Then
rng.Select
End If
Next
End Sub
(this should propably be simple, but somehow i cannot find a solution.)
I simply want to read the current line of my selection into a variable in vba. I do not know the current paragraph. The selection is at the very beginning of the line.
My document looks like this.
First of all I select the first row of the table. Then i move one paragraph up. Now thats the line I want. As you can see in my second img, I only have the first character.
For Each tbl In fileInsertRange.Tables
tbl.Rows(1).Select
' save caption
Selection.Collapse
Selection.MoveUp WdUnits.wdParagraph, 1
tableCaption = Selection.Text
If you want to store all your tables captions in a variable than try this code. Keep in mind you'd need to use the tableCaption variable right away before it gets overwritten by the next tables caption or add an array to store all of the captions.
Sub get_table_caption()
Dim currentTable As Table
Dim tableCaption As String
'Loop through all tables on active document
For Each currentTable In ActiveDocument.Tables
'Get tables caption and store in a variable called "tableCaption"
currentTable.Select
Selection.Collapse
Selection.MoveUp WdUnits.wdParagraph, 1
Selection.Expand wdLine
tableCaption = Selection.Text
Debug.Print tableCaption
'Do stuff with the tables caption
Next
End Sub
If you want to continue doing it your way by selecting the first row of the table and finding that tables caption than try this code:
Sub get_table_caption()
Dim tableCaption As String
'Get tables caption and store in a variable called "tableCaption"
Selection.Collapse
Selection.MoveUp WdUnits.wdParagraph, 1
Selection.Expand wdLine
tableCaption = Selection.Text
Debug.Print tableCaption
End Sub
Hope that helps. Good luck.