I'm trying to develop some code that prints a pdf of a specific view and filter of my schedule and saves the file in a specific folder with a specific name then repeats for a new filter and a new pdf name
I currently have this but I have to manually enter the file name in the Save print Output As popup
Really hope someone can help
Regards
John
Sub PrintThisFile()
Dim Names As String
Names = ActiveProject.Name
Names = Replace(Names, ".mpp", "")
ViewApply Name:="Gantt Chart"
OutlineShowAllTasks
FilterApply Name:="Filter1"
FilePrint FromDate:="18/10/22 5:00 AM", ToDate:="6/11/22 5:00 AM"
ViewApply Name:="Gantt Chart"
FilterApply Name:="Filter2"
FilePrint FromDate:="18/10/22 5:00 AM", ToDate:="6/11/22 5:00 AM"
PaneClose
MsgBox ("Documents have been saved")
End Sub
Related
A retiree friend leaving wants to leave a "present" and I'm trying to help.
A file is open and the macro is run, a file picker dialog allows the user to select the first file,columns removed, items are filtered out and deleted, the file picker then allows the user to choose a second file, items are filtered out and deleted,columns removed, the two sheets are combined into one and the new file is saved in a different location.
Sub SectionEightReport()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Application.ScreenUpdating = False 'speed up macro execution
Application.DisplayAlerts = False
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
'Use the Show method to display the File Picker dialog box and return the user's action.
.InitialFileName = "\\marnv006\Bm\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\Blue Deck\"
If .Show = -1 Then
'The user pressed the action button.
'switch of updating to speed your code & stop irritating flickering
For Each vrtSelectedItem In .SelectedItems
rc = ShellExecute(0, "open", vrtSelectedItem, vbNullChar, _
vbNullChar, 1)
Application.CutCopyMode = True
DoEvents
Not sure how to proceed here...
User will open the first file (latest file) like:
Workbooks.Open Filename:= _
"\\marnv006\Bm\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\Blue Deck\Blue Deck 2016\Section 5\Section 5_11_07_2016.xls"
Columns N:V in this document get deleted and the sheet renamed to "Section 5 (Current) Something like:
Columns("N:V").Delete
Then all items with values of "1/0/1900" & "N/A" get deleted
User will open the previous file something like:
Workbooks.Open Filename:= _
"\\marnv006\Bm\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\Blue Deck\Blue Deck 2016\Section 5\Section 5_10_24_2016.xls"
Columns N:V in this document get deleted and the sheet renamed to "Section 5 (Previous)"
Columns("N:V").Delete
The two sheets get combined into one workbook.
New file will be saved in "\\marnv006\\Bm\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\Blue Deck\Blue Deck 2016\Section 8\"
The file name will be "Section_8_" & the date in the format likes this "11_11_2016"
Then in Column N6:N of the "Section 5 (Current)" sheet an Index Match is applied.
Something like "=OFFSET(INDEX('Section 5 (Previous)'!R6C1:R[1994]C1,MATCH('Section 5 (Current)'!RC1,'Section 5 (Previous)'!R6C1:R[1994]C[-13],0)),0,12)"
also "=OFFSET(INDEX('Section 5 (Previous)'!$A$6:$A1889,MATCH('Section 5 (Current)'!$A6,'Section 5 (Previous)'!$A$6:A1889,0)),0,12)"
The header of this column is "Previous DSC Release Schedule" and the text is wrapped.
In column O6 the formula "=N6-M6" is applied through the last row.
This column header is "Variance (Days) and the text is wrapped.
Column N is formatted as a date; something like:
Columns("N:N").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("N:N").EntireColumn.AutoFit
Column O is formatted as a number; something like:
Columns("O:O").Select
Selection.NumberFormat = "0"
Finally, in column O ""Variance (Days)") all items with "0" are deleted.
File is saved as mentioned above
End Sub
I am having trouble getting this macro to work. I am working on a Windows 10 computer with Office 2013. The code was not written by me and I have limited knowledge in VB. The marco is supposed to update a a word document's links by mirroring how the the previous word document was linked. Below is the code, if anyone could help that would be great.
Sub relinking()
Dim oriacro As String
Dim taracro As String
Dim path As String
oriacro = InputBox(Prompt:="please enter the original agency acronym.", Title:="ENTER THE ORIGINAL AGENCY ACRONYM")
taracro = InputBox(Prompt:="please enter the target agency acronym.", Title:="ENTER THE TARGET AGENCY ACRONYM")
path = InputBox(Prompt:="please enter the target path.", Title:="ENTER THE TARGET PATH")
Excel.Application.Quit
'close all the excel files.(excel reference has to be activated in tool->reference'
For x = 1 To ActiveDocument.Fields.Count
'the program runs over all the linked fields'
If Left(ActiveDocument.Fields(x).LinkFormat.SourceNam e, Len(oriacro)) = oriacro Then
'read all the fields that has "original agency acronym" in the beginning of its linked excel files.'
ActiveDocument.Fields(x).LinkFormat.SourceFullName = path & "\" & taracro & "_" & Right(ActiveDocument.Fields(x).LinkFormat.SourceNa me, Len(ActiveDocument.Fields(x).LinkFormat.SourceName ) - InStr(ActiveDocument.Fields(x).LinkFormat.SourceNa me, "_"))
'Assign the fields with new links that are created from combining the "target path" ,"target agency acronym", and the parts of the names right after the original acronyms of the original linked file names.'
Else
'Leave other linked fields as they are.'
End If
Next x
MsgBox ("All Fields have been relinked!")
End Sub
1) few typos in the above code which might just be formatting on StackOverflow: .SourceNam e a couple times. Also in the function which makes the new path:
Right(ActiveDocument.Fields(x).LinkFormat.SourceNa me, Len(ActiveDocument.Fields(x).LinkFormat.SourceName ) - InStr(ActiveDocument.Fields(x).LinkFormat.SourceNa me, "_")).
Also add a string variable and catch one of them in a msgbox to test:
If Left(ActiveDocument.Fields(x).LinkFormat.SourceNam e, Len(oriacro)) = oriacro Then
'read all the fields that has "original agency acronym" in the beginning of its linked excel files.'
str = ActiveDocument.Fields(x).LinkFormat.SourceName 'Dim str variable above if necessary
ActiveDocument.Fields(x).LinkFormat.SourceFullName = path & "\" & taracro & "_" & Right(str, InStrRev(str, "_")-1)
'Assign the fields with new links that are created from combining the "target path" ,"target agency acronym", and the parts of the names right after the original acronyms of the original linked file names.'
msgbox ActiveDocument.Fields(x).LinkFormat.SourceFullName 'does this message show the proper path??
Else
'Leave other linked fields as they are.'
End If
ActiveDocument.Fields.Update
I have a program that prompts the user to select a document from a file explorer window, that they can then rename to what they want, and it will show up as a hyperlink in the active cell, that on click, will open up the linked file. However I want to restrict the files they can link to a certain path (like this s:/folder/folder/folder/fileLocation). Here is my code:
strFileName = Application.GetOpenFilename("*.*, All Files", , , , False)
If strFileName = "False" Then
Exit Sub 'Code that responds when the user cancelled and does not want to add a file to the database
End If
strShortName = InputBox("What do you want to call this link?", "File Name", strFileName) 'Prompts the user to insert
'the name of the file
If strShortName = "" Then Exit Sub 'Attaches the entered name to document
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=strFileName, TextToDisplay:=strShortName
ActiveCell.Offset(1).EntireRow.Insert
'The above code creates a hyperlink using the entered name and connects it to the document
'that was first selected to insert into the database
prompt2:
strdate = InputBox("Please enter the date that you received this file in the following format: MM/DD/YYYY .", "date received", strdate)
If strdate = "" Then
Selection.EntireRow.Delete
Exit Sub 'Code that responds when the user cancelled and does not want to add a file to the database
ElseIf Len(strdate) < 12 Then 'This code makes sure that the date is real and inserts it in the
Cells(ActiveCell.Row, 8) = strdate 'correct row in the corresponding column
Else
MsgBox ("Please enter the date in the correct format.") 'Message box that informs the user to insert correct format
GoTo prompt2 'and restarts the prompt for another attempt
End If
End If
Else
MsgBox ("You cannot add a document here.") 'This handles if a user enters code into a column that does not correspond
Exit Sub
End If
The solutions I have tried follow:
If InStr(1, strFileName, "s:/folder/folder/folder/fileLocation") = 1 Then
MsgBox "This is a valid location to select file from"
End If
and:
If strFileName Like "s:/folder/folder/folder/fileLocation*"Then
msgBox("This is a valid location to seclect file from")
End If
Neither of these work at all.
Thanks for any help.
Could try
If instr(1,strFileName,"s:/") >0 Then
msgBox("This is a valid location to seclect file from")
End If
basically if search string ("S:/") is in strFileName then it will return >0
Use / do access URL paths.
Use \ to access local paths.
Didn't you misplaced / for \?
Background: I want to use a specific entered text from a TextBox for the default filename in the SaveAs dialog.
I have implemented the following VBA script in my document, a Word 2010 template .dotm
Sub FileSaveAs()
'for testing
Dim fileName As String
fileName = Me.tb_myTextBox.Value & "_MyFileNameToSave"
MsgBox fileName
'use specific file name in save dialog
With Dialogs(wdDialogFileSaveAs)
.Name = fileName
.Show
End With
End Sub
It works fine, when I run it. I saved the .dotm, closed it and reopened it out from the Windows Explorer (means as "end user").
BUT in this case, means after open the template document as "end user" (so that I can save a new doc out of it and not overwrite the template), the content/value of the TextBox is empty, even if I entered something into it.
So, how can I read out the data of the TextBox in "document mode" of a template?
Presumably, the OP's intention was something along the lines of:
Sub FileSaveAs()
Dim StrNm As String
With ActiveDocument
StrNm = Split(.Shapes(1).TextFrame.TextRange.Text, vbCr)(0) & "_MyFileNameToSave"
'use specific file name in save dialog
With Dialogs(wdDialogFileSaveAs)
.Name = StrNm
.Show
End With
End With
End Sub
where .Shapes(1) identifies the particular textbox Shape object.
how can I read out the data of the TextBox in "document mode" of a template?
Not sure what you mean. This works for me:
create a form:
Private Sub btn_OK_Click()
Dim fileName As String
fileName = tb_myTextBox.Value & "_MyFileNameToSave"
With Dialogs(wdDialogFileSaveAs)
.name = fileName
.Show
End With
End Sub
create a sub to call this form:
Sub FileSaveAs()
UserForm1.Show
End Sub
This is all saved in a template / .dotm.
Now, create a document off of the template (double click the template to launch document off of it). Alt + F8 and run the macro from the template (you may have to select the template from the "Macros in" drop down). Result: my form comes up, I enter a name for the document, press ok, and the Word Save As dialog appears with the name I gave to the document.
I am trying to create a Word document with a very simple word macro. The macro searches for a bookmark that I have placed in the text and then adds a date, 2 weeks into the future, at that location.
But when I create a new document from the template I keep getting bookmark not found. I have been through it loads of times and sometimes the bookmark is there, sometimes its there but not allowing you to click "Go to".
How can I get it to work? I have added a little piece of code to the Document_New() event but that keeps reporting Bookmark not found.
I have the document in a rar-file since my webserver can't handle .dotm extensions.
Document
How can I make it so that when a new document is produced from this template, the new document has the date, 2 weeks ahead, placed between the 2 bold sections?
Sub Two_Weeks_Ahead()
''# Two_Weeks_Ahead Makro
Selection.GoTo What:=wdGoToBookmark, Name:="TwoWeeks"
With ActiveDocument.Bookmarks
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Dim dt As Date
dt = DateAdd("d", 14, DateTime.Now)
Selection.TypeText Text:=Format(dt, "yyyy-MM-dd")
End Sub
Private Sub Document_New()
Selection.GoTo What:=wdGoToBookmark, Name:="TwoWeeks"
With ActiveDocument.Bookmarks
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Dim dt As Date
dt = DateAdd("d", 14, DateTime.Now)
Selection.TypeText Text:=Format(dt, "yyyy-MM-dd")
End Sub
This might be because of the use of ActiveDocument in your code. The calling macro's document may still be the ActiveDocument, so it wouldn't find any bookmark. Here's how I would do it from a calling macro-enabled document/template which works well.
Sub AddTwoWeeks()
Dim d As Document
Set d = Documents.Add("C:\Users\Me\Desktop\Title.dotx")
Dim dt As Date
dt = DateAdd("d", 14, DateTime.Now)
Dim b As Bookmark
Set b = d.Bookmarks("TwoWeeks")
b.Range.Text = Format(dt, "yyyy-MM-dd")
End Sub