Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
dannutzza
 | Femeie
25 ani
Mehedinti
cauta Barbat
25 - 52 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 18 ani
Postari: 2247
|
|
Sub Word_ExportPDF()
'PURPOSE: Generate A PDF Document From Current Word Document
'NOTES: PDF Will Be Saved To Same Folder As Word Document File
'SOURCE:
Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
Dim UniqueName As Boolean
UniqueName = False
'Store Information About Word File
myPath = ActiveDocument.FullName
CurrentFolder = ActiveDocument.Path & "\"
FileName = Mid(myPath, InStrRev(myPath, "\") + 1, _
InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
'Does File Already Exist?
Do While UniqueName = False
DirFile = CurrentFolder & FileName & ".pdf"
If Len(Dir(DirFile)) <> 0 Then
UserAnswer = MsgBox("File Already Exists! Click " & _
"[Yes] to override. Click [No] to Rename.", vbYesNoCancel)
If UserAnswer = vbYes Then
UniqueName = True
ElseIf UserAnswer = vbNo Then
Do
'Retrieve New File Name
FileName = InputBox("Provide New File Name " & _
"(will ask again if you provide an invalid file name)", _
"Enter File Name", FileName)
'Exit if User Wants To
If FileName = "False" Or FileName = "" Then Exit Sub
Loop While ValidFileName(FileName) = False
Else
Exit Sub 'Cancel
End If
Else
UniqueName = True
End If
Loop
'Save As PDF Document
On Error GoTo ProblemSaving
ActiveDocument.ExportAsFixedFormat _
OutputFileName:=CurrentFolder & FileName & ".pdf", _
ExportFormat:=wdExportFormatPDF
On Error GoTo 0
'Confirm Save To User
With ActiveDocument
FolderName = Mid(.Path, InStrRev(.Path, "\") + 1, Len(.Path) - InStrRev(.Path, "\"))
End With
' MsgBox "PDF Saved in the Folder: " & FolderName '**********************************************
Exit Sub
'Error Handlers
ProblemSaving:
MsgBox "There was a problem saving your PDF. This is most commonly caused" & _
" by the original PDF file already being open."
Exit Sub
End Sub
Function ValidFileName(FileName As String) As Boolean
'PURPOSE: Determine If A Given Word Document File Name Is Valid
'SOURCE:
Dim TempPath As String
Dim doc As Document
'Determine Folder Where Temporary Files Are Stored
TempPath = Environ("TEMP")
'Create a Temporary XLS file (XLS in case there are macros)
On Error GoTo InvalidFileName
Set doc = ActiveDocument.SaveAs2(ActiveDocument.TempPath & _
"\" & FileName & ".doc", wdFormatDocument)
On Error Resume Next
'Delete Temp File
Kill doc.FullName
'File Name is Valid
ValidFileName = True
Exit Function
'ERROR HANDLERS
InvalidFileName:
'File Name is Invalid
ValidFileName = False
End Function |
_______________________________________
|
|
| pus acum 6 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 795
|
|
To set the PDF to be saved on Desktop instead of the file's path / directory, replace the CurrentFolder line in the beginning with:
CurrentFolder = Environ("USERPROFILE") & "\Desktop\"
|
|
| pus acum 5 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 795
|
|
After this line:
| ' MsgBox "PDF Saved in the Folder: " & FolderName '********************************************** |
You can add the following 3 lines of code (the text written in red is not required)
- 1st line so that after converting to PDF to automatically close the word document without saving the changes.
- 2nd and 3rd lines to close the remaining word window
' Close document without saving changes AND CLOSE WORD WINDOW
'Dim appWd As Word.Application ' NOT WORKING
'Set appWd = CreateObject("Word.Application") ' NOT WORKING
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
'appWd.Quit ' NOT WORKING
'Set appWd = Nothing ' NOT WORKING
' ANOTHER WAY TO CLOSE WORD WINDOW
Dim x As Variant
x = Shell("powershell.exe kill -processname winword", 1) |
Source:
|
|
| pus acum 4 ani |
|