Add password request in Microsoft Word Macro - vba

In Microsoft Word, I have created a macro-enabled template which can used to insert a predefined image (such as a scan of a signature) into the current cursor position with the click of a button.
In order to make it a little more secure from misuse, I'd like to know if there is a way I can add a password request to display once the button is clicked before it then adds the image if the input password is correct, or displays a message such as 'wrong PIN - access denied' if incorrect.
If there is, how do I do this?
The macro code currently used is quite simply:
Sub SophieSignature()
'
' SophieSignature Macro
'
'
Selection.InlineShapes.AddPicture FileName:= _
"\\192.168.1.1\Management\Sophie\sophie-signature.JPG", LinkToFile:=False, _
SaveWithDocument:=True
End Sub

Related

Copy selected text from one document and paste to new document in same position on the page

I was looking for a long time but unfortunately I cannot get a clear answer anywhere.
What I need is to copy selected text from one word document than open new document and paste the text to new document but in the exactly same position in the page as the original text.
Here is what I done so far:
Sub Patient()
Dim answer As Integer
answer = MsgBox("Please select text to copy", vbQuestion + vbYesNo + vbDefaultButton1, "Info")
If answer = vbYes Then
ActiveDocument.Bookmarks.Add _
Name:="myplace", Range:=Selection.Range
Selection.GoTo What:=wdGoToBookmark, Name:="myplace"
With ActiveDocument.Bookmarks
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Selection.Copy
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
Windows.CompareSideBySideWith "Test_Document.docx"
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Else
MsgBox "Please highlight the text first", 16
End If
End Sub
So what I done:
1- force the user to select the text to copy, if no selection is made the error message will appears.
2- set the bookmark to name "myplace"
3- copy the bookmark
4- open the new document
4- set the view side by side
5- paste the bookmark text to new document
6- I was manually formatting the text using enter to get it to required location so I can print it on existing paper.
What I need is that the selected text will by pasted to exact location on the page as original.
The original text selection can be anywhere on the page, depends on what the user selects.
I also found that the MS Word can count start and end of my bookmark so I was hoping we can write the VBA to position of pasted text exactly where the original bookmark was:
Sub Count()
With ActiveDocument.Bookmarks("myplace")
MsgBox .Range.Start & vbTab & .Range.End
End With
End Sub
Let me describe what I am trying to achieve and why I need this function.
I have a patient record, where I write basic info about the patient like name, address, telephone number etc., and then I have therapy where I describe all the symptoms and progress what the patient make trough time.
I than print the document and store it in cabinet as hard copy, as this is legal requirements.
The patient may have many visits, so I keep adding the info to the existing record and each time I need to print it.
In order to save paper, I would like to have only the new added text to be printed on the same document I printed already. I always put the existing doc back to printer.
I know that the MS Word offers print selection option but when selected text is printed, it is always printed on top of the document and this will print over my existing text.
So what I was trying to do is select the required text, assign bookmark, copy bookmark, open new document, paste the text, set the view side by side and then I was manually formatting the text using enter to get it to required location so I can print it on existing paper.
Is there any other way to achieve this than VBA?
I would be grateful for any advice or help.
Many thanks,
Peter.

Create macro to make text into hyperlink concatenating the display text to standard format

I have to create a large number of hyperlinks for ticket items where the only part of the URL that changes is the ticket ID. I am new to this and much of the VBA help is for excel. My problem exists in MS-word and its difficult to transfer the syntax.
I expect the user to invoke the macro after entering a 6 digit Ticket ID. Ideally the macro would automatically select the last word typed by the user, and append it to the url segment which never changes.
I attempted to record a macro that copies the last word typed then concatenates it onto the end of the standard URL.
I can successfully do everything with keyboard shortcuts so I thought I would be set. The problem is the macro just uses the text from the recording example. It also turns my text to display to the example text.
Turning any text into the link I used as an example in the recording.
I can't figure out how to make VBA use the copied text for the text to display and the last 6 digits of the URL.
Please see VBA syntax below
Sub textToHyperlink()
'
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
ChangeFileOpenDirectory _
"/Users/chris/Library/Containers/com.microsoft.Word/Data/Library/Preferences/AutoRecovery/"
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
"https://someboringwebsite.com/WorkItem&id=123456", SubAddress:="", ScreenTip:="", _
TextToDisplay:="123456"
End Sub
This may work:
Sub textToHyperlink()
'
Dim TicketID As String
TicketID = Selection.Range.Text
'You may need to clean up TicketID (remove <CR> etc.) before
'sticking it in the hyperlink. Depends on what's in Selection.
' Not sure what this line does
' ChangeFileOpenDirectory _
"/Users/chris/Library/Containers/com.microsoft.Word/Data/Library/Preferences/AutoRecovery/"
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
"https://someboringwebsite.com/WorkItem&id=" & TicketID, SubAddress:="", ScreenTip:="", _
TextToDisplay:=TicketID
End Sub
Hope that helps.
The following is in response to your clarification in a comment (which I've incorporated into your question). There are two variations
1) Following your premise, working with user input. Note that this will take the preceding word, no matter where it is in the text. And in the case the user may have typed a space (or many spaces) all spaces are removed from the end of that word. (These lines of code are commented out.)
2) You (and the user) might find it simpler to work with an InputBox so that the user can type the ticket id directly - no worries about where it is in the text, or spaces, or anything. The hyperlink is inserted at the selection.
Sub textToHyperlink()
'
Dim sID As String
' Dim rng As word.Range
'
' Set rng = Selection.Range
' rng.MoveStart wdWord, -1
' sID = Trim(rng.Text)
sID = InputBox("Please enter the ticket ID")
ActiveDocument.Hyperlinks.Add anchor:=rng, Address:= _
"https://someboringwebsite.com/WorkItem&id=" & sID, SubAddress:="", ScreenTip:="", _
TextToDisplay:=sID
End Sub

Word Paste Behavior Not the Same in VBA

I have a document with a number of embedded hyperlinks to convert to plain hyperlinks. Whether they get pasted as clickable URLs or plaintext URLs doesn't matter, as long as it's actually displaying the URL.
For example, I need to change Microsoft Word to http://en.wikipedia.org/wiki/Microsoft_Word (either clickable or not).
In Word, if I select the hyperlink, right click, choose "copy hyperlink," then paste special, text only, I get the optimal result (non-clickable URL). If I record VBA code that does the exact same thing, the result is the original embedded link. I've played with various options: turning off smart paste, cut and paste, turning off autoformat of hyperlinks, changing the default paste options, but none of these change my end result.
Sub Replace_w_URLs()
'
' Replace_w_URLs Macro
'
'
Selection.NextField.Select
Selection.Range.Hyperlinks(1).Range.Fields(1).Result.Select
Selection.Copy
Selection.TypeBackspace
Selection.PasteSpecial Link:=False, DataType:=20, Placement:=wdInLine, _
DisplayAsIcon:=False
End Sub
The problem is likely the default behaviour of Word to add a hyperlink if it recognizes that the text you pasted is a URL. If you're doing this in a loop, it does the same thing as if you put the cursor at the end of the URL and hit the space-bar.
The easiest way to avoid this is to just operate on the hyperlink Ranges themselves and just change the text property. When you change HyperLink.Range.Text, it has the side effect of also removing the hyperlink at the same time.
Give this a shot:
Sub Replace_w_URLs()
Dim url As Range
Do While Selection.Hyperlinks.Count > 0
Set url = Hyperlinks(1).Range.Duplicate
url.Text = Hyperlinks(1).Address
Loop
End Sub
It should replace all of the hyperlinks in your Selection with the underlying URLs.

Using vba to copy the contents of a word document into another word document

I haven't used VB for years, so please forgive me if this turns out to be obvious. I'm trying to write a word vba macro for use in a template which will display a userform and then import the contents of fileA.docx, fileB.docx, or fileC.docx depending on the userform. (After that I'm going to use bookmarks to fill in some form data, I don't know if that's relevant). Files A, B, and C will contain text with some basic formatting such as lists, but nothing fancy.
The solutions I've seen online can copy the contents of file to a new file, but ideally I would like to import the entirety of one of those files into the new, currently unnamed file that I'm getting from the template. I think where I'm running into problems is with switching the selection to one of those files, and then back to the new unnamed document, though I could use a hand to make sure I'm copying correctly as well.
Update: I was making things too hard, though the answers here got me pointed in the right direction (thanks!). In the end I just did
ThisDocument.Activate
Selection.InsertFile("fileA")
which gives me the raw dump of everything that I wanted.
Using commands such as these you can switch between which Document you're using and copy and paste elements:
ThisDocument.Activate 'Sets the main document active
Documents("Name.doc").Activate 'Activates another document
You can insert, copy and paste things in and out of documents using copy commands.
ThisDocument.Range.InsertAfter("String") 'Insert text
Selection.WholeStory 'Select whole document
Selection.Expand wdParagraph 'Expands your selection to current paragraph
Selection.Copy 'Copy your selection
Documents("name.doc").Activate 'Activate the other document
Selection.EndKey wdStory 'Move to end of document
Selection.PasteAndFormat wdPasteDefault 'Pastes in the content
You can then go and format such, or copy and paste them with original formatting from before.
Here is a significant improvement (I think) you will want to incorporate because it:
does not use the clipboard and thus does not make your macro vulnerable to the user changing the contents of the clipboard while your macro is running
does not use a file and thus greatly improve the speed by eliminating I/O and eliminates the potential of having to deal with file system security/permissions, etc. Please do not use .InsertFile() if you are looping through documents you will slow yourself down. Use it once, at the end -only if you have to. The example below shows how to accomplish the same result without using .InsertFile()
The idea is to transfer some portion of text found in 1 source document, to a destination document that is different than the source, and keep the source formatting.
To accomplish the above (skipping the code to open documents):
For Each oTable In oDoc_Source
'the above could have been anything that returns a Range object
'such as: ActiveDocument.Content.Find.Execute ....
'...
'logic here to identify the table, or text, you are looking for
'...
'I can't believe the MS Dev Center folks could only think
'of .InsertFile(), which is the last resort I would go for,
'especially if your code runs on a web server [concurrent web requests]!
'SAFEST
'(no user interference on clipboard possible, no need to deal with file i/o and permissions)
'you need a reference to Document.Content,
'as the act of obtaining a reference "un-collapses" the range, so the below 3 lines must be in that order.
Set oRange = oDoc_DestinationDoc.Content
oRange.Collapse Direction:=wdCollapseEnd
oRange.FormattedText = oTable.Range
'BRUTE, AND PRONE TO RANDOM ERRORS AND HANGS DUE TO USER INTERFERENCE WITH CLIPBOARD
'find a way to implement WIHTOUT using the CLIPBOARD altogether to copy the below range object
'it will be easier for PC users to use the clipboard while the macro runs
'and it will probably be safer for the output of this macro to remain uncorrupted
'oTable.Range.Copy
'Set oRange = oDoc_DestinationDoc.Content
'oRange.Collapse Direction:=wdCollapseEnd
'oRange.Paste
'THE BELOW DOES NOT WORK
' '1) - cannot add a range from another document
' 'adds only text, not the formats and not the table layout
' oTable.Range.TextRetrievalMode.IncludeFieldCodes = True
' oTable.Range.TextRetrievalMode.IncludeHiddenText = True
' oDoc_DestinationDoc.Content.InsertAfter oTable.Range
'
' '2) - cannot add a range from another document
' oDoc_DestinationDoc.Content.Tables.Add oTable.Range, iRowMax, iColMax
'
' '3) - only puts in plain text, and it replaces the range without the .Collapse call
' oDoc_DestinationDoc.Content.Text = oTable.Range
Record a macro...
start in the source document
press ctrl-a to select everything
press ctrl-c to copy it to the clipboard
switch to the target document
press ctrl-v to paste into the document
stop recording
or (assuming word 2007 or later)
start in the target document with the source document closed
on the ribbon click insert > object > Text from file...
navigate to the source document
click the insert button
stop recording
I prefer the second version so I should have put it first
I was doing the same thing, tried to select the other document, copy and paste. But it didn't worked (I received an error probably because some other application was using the clipboard, but I am not sure.). So I did a little search and found the perfect solution on Microsoft Dev Center.
https://msdn.microsoft.com/en-us/vba/word-vba/articles/selection-insertfile-method-word
Selection.Collapse Direction:=wdCollapseEnd
Selection.InsertFile FileName:="C:\TEST.DOC"
'set current doc name and path
Dim docName As String: docName = ActiveDocument.name
Dim filepath As String: filepath = ActiveDocument.Path
'create a new file
Documents.Add
'get the path of a current file
ChangeFileOpenDirectory filepath
'insert content of current file to newly created doc
Selection.InsertFile _
FileName:=docName, _
Range:="", _
ConfirmConversions:=False, _
Link:=False, _
Attachment:=False
'open prompt to save a new file
With Dialogs(wdDialogFileSaveAs)
.name = docName & "-copy"
.Show
End With

Excel VBA: Confirmation on Pressing CommandButton

Upon pressing my CommandButton, I would like to have a pop-up that asks "These changes cannot be undone. It is advised to save a copy before proceeding. Do you wish to proceed?"
And I want to have three options:
Yes - pop-up window is closed and CommandButton Macro is executed
No - This closes the pop-up window and changes nothing
Save - closes pop-up window and opens "Save As" (macro is not executed)
I don't really know where to start with this. Could you please give me a hand?
Thank you very much indeed.
You can use a message box, but that is somewhat limited. You can rephrase the question slightly to use the vbYesNoCancel buttons, since Save As is not an optional button on Message Box.
Then you can work with the result of the message box button-click:
Dim mbResult as Integer
mbResult = MsgBox("These changes cannot be undone. Would you like to save a copy before proceeding?", _
vbYesNoCancel)
Select Case mbResult
Case vbYes
'Modify as needed, this is a simple example with no error handling:
With ActiveWorkbook
If Not .Saved Then .SaveAs Application.GetSaveAsFilename()
End With
Case vbNo
' Do nothing and allow the macro to run
Case vbCancel
' Do NOT allow the macro to run
Exit Sub
End Select
I suggest you put code at the top of your macro to ask this question and respond to the answer.
This would look something like:
Sub YourMacro()
if MsgBox("These changes cannot be undone. It is advised to save a copy before proceeding. Do you wish to proceed?", vbYesNo + vbQuestion) = vbNo then
exit sub
end if
... the rest of your macro.
Note that this will not give the user the Save option. You can't do that with a standard MsgBox. If you want to do that, you will need to create your own userform, show that instead of the MsgBox and respond to what button in the Userform the user pushed. That is a lot more work for you than just using a MsgBox, but if you want your UI to be fancy, it may be worth it.