Modificare le proprietà documento Word con una macro

Question

Buona sera, avrei le seguenti necessità:

1. Impostare la proprietà Titolo attraverso una macro
2. Salvare il file come PDF con il nome presente nella proprietà Titolo

E' possibile?

Grazie

Answer 1

Ciao RobertoBellini,

allora la macro potrebbe essere questa:

Option Explicit

Public Sub Test2()

Const cstrProc = "Test2"

On Error GoTo ErrH

Const cstrPath = "" ' <--- Personalizzare.

'

' Esempi di personalizzazione della costante 'cstrPath':

'

' cstrPath = "" ' Salva come PDF nella stessa cartella del Documento

'               ' Se il Documento non è ancora stato salvato, salva

'               ' nella cartella predefinita.

' cstrPath = "D:\Pippo" ' Salva come PDF nel percorso specificato.

Dim wdDoc   As Word.Document

Dim msoPrp  As Office.DocumentProperty

Dim strPath As String

Dim strName As String

Dim p       As String

    Set wdDoc = ThisDocument

    Set msoPrp = wdDoc.BuiltInDocumentProperties("Title")

    If Len(msoPrp.Value) Then

      strName = msoPrp.Value

    Else

      MsgBox "Impossibile salvare come PDF con Nome uguale al valore" _

           & " della Proprietà 'Title'." _

           & vbNewLine & "Non è ancora stato assegnato un valore" _

           & " alla Proprietà 'Title'." _

           , vbOKOnly Or vbExclamation _

           , cstrProc

      GoTo ExtP

    End If

    With wdDoc

      If Len(cstrPath) Then

        strPath = cstrPath

      Else

        If Len(.Path) Then

          strPath = .Path

        Else

          strPath = .Application.Options.DefaultFilePath(wdDocumentsPath)

        End If

      End If

      p = .Application.PathSeparator

      If Right$(strPath, 1) <> p Then strPath = strPath & p

      .ExportAsFixedFormat strPath & strName, wdExportFormatPDF

    End With

ExtP:

    On Error Resume Next

    Set msoPrp = Nothing

    Set wdDoc = Nothing

    Exit Sub

ErrH:

    With Err

      MsgBox "ERR#" & CStr(.Number) _

           & vbNewLine & .Description _

           , vbOKOnly Or vbCritical _

           , cstrProc

    End With

    Resume ExtP

End Sub

Answer 2

Ciao

si per un altro fil word che sto impostando

Answer 3

Ciao RobertoBellini,

cioè il contrario di quel che hai chiesto prima? Quindi il valore della proprietà "Titolo" del documento verrà assegnata a mano e la macro dovrà solo stampare il pdf con nome file uguale al valore di tale proprietà. Ho capito giusto?

Answer 4

Grazie Maurizio!

Se volessi impostare cstrTitle non con un valore fisso, ma con il contenuto Title della proprietà del documento come devo fare ?

Grazie 

Const cstrTitle = "Un titolo"  ' <--- Personalizzare

Answer 5

Ciao RobertoBellini,

vedi se fa al caso tuo.

Option Explicit

Public Sub Test1()

Const cstrProc = "Test1"

On Error GoTo ErrH

Const cstrTitle = "Un titolo"  ' <--- Personalizzare

Const cstrPath = "D:\Percorso" ' <--- Personalizzare 

                               '      Se = "" salva nella stessa

                               '      cartella del documento.

Dim wdDoc   As Word.Document

Dim msoPrp  As Office.DocumentProperty

Dim strPath As String

Dim strName As String

Dim p       As String

    Set wdDoc = ThisDocument

    Set msoPrp = wdDoc.BuiltInDocumentProperties("Title")

    msoPrp.Value = cstrTitle

    wdDoc.Save    ' ?...

    p = Application.PathSeparator

    With wdDoc

      If Len(cstrPath) Then

        strPath = cstrPath

      Else

        strPath = wdDoc.Path

      End If

      If Len(strPath) = 0 Then

        ' Il documento non è mai stato salvato... Che fare?

        MsgBox "Qui bisogna decidere cosa fare."

        GoTo ExtP

      End If

      If Right$(strPath, 1) <> p Then strPath = strPath & p

      strName = cstrTitle

    End With

    wdDoc.ExportAsFixedFormat strPath & strName, wdExportFormatPDF

ExtP:

    On Error Resume Next

    Set msoPrp = Nothing

    Set wdDoc = Nothing

    Exit Sub

ErrH:

    With Err

      MsgBox "ERR#" & CStr(.Number) _

           & vbNewLine & .Description _

           , vbOKOnly Or vbCritical _

           , cstrProc

    End With

    Resume ExtP

End Sub