Sulla base di quanto hai detto...
Creati un documento master vuoto, che io ho chiamato VALLE_Master.docm, in cui inserirai queste due macro:
- Codice: Seleziona tutto
Sub NewMyDoc()
Dim XlApp, XlWb, myNext As Long
'
Documents.Add Template:= _
"C:\Users\UTENTE1\AppData\Roaming\Microsoft\Templates\ZCPROT.dotx", _
NewTemplate:=False, DocumentType:=0 '<<< Il vero path del Modello
ActiveDocument.SaveAs2 FileName:="ZCPIPPO.docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=14
Selection.GoTo What:=wdGoToBookmark, Name:="zcProt"
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Set XlApp = CreateObject("excel.application")
XlApp.Visible = True
Set XlWb = XlApp.Workbooks.Open("C:\Users\Utente1\Documents\VALLE_PROT.xlsx") '<<< Il vero percorso del file XL
myNext = XlWb.sheets("Prot").Range("A65000").End(-4162).Row + 1
cprot = XlWb.sheets("Prot").Range("A" & (myNext - 1)).Value
If IsNumeric(cprot) Then
cprot = cprot + 1
Else
cprot = 1
End If
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.TypeText Text:=Format(cprot, "0000") & " "
With XlWb.sheets("Prot")
.Cells(myNext, 1).Value = cprot
.Cells(myNext, 2).Value = Now
.Cells(myNext, 3).Value = Environ("UserName")
End With
'
XlWb.Close True
XlApp.Quit
'
Selection.HomeKey Unit:=wdStory
ActiveDocument.Save
End Sub
- Codice: Seleziona tutto
Sub SalvaProt()
'
myPath = ThisDocument.Path & "\" 'Usare un eventuale diverso Path
Documents("ZCPIPPO.DOCX").Activate
Selection.GoTo What:=wdGoToBookmark, Name:="zcProt"
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
'
If IsNumeric(Selection.Text) Then
ActiveDocument.SaveAs2 (myPath & Selection.Text)
Else
MsgBox ("il campo Protocollo non contiene un numero: " & vbCrLf & Selection.Text _
& vbCrLf & "Salvare il fil manualmente prima di continuare")
End If
'
End Sub
Poi ti crei un "Modello di Word" che sara' usato per creare il tuo "nuovo documento"; mettici le informazioni che vuoi, e inserisci un "
Segnalibro" che chiamerai "zcPROT" nella posizione in cui vuoi poter inserire la numerazione progressiva. Salva il modello come zcPROT.dotx nella posizione dei modelli (che credo sia C:\Users\UTENTE\AppData\Roaming\Microsoft\Templates)
Quindi crea il file Excel che chiamerai VALLE_Prot.xlsx, contenente un foglio Prot col seguente layout:
I tre numeri sono stati assegnati durante le mie prove, in quelle date e a quegli Utenti (il campo Data in realta' contiene anche l'ora, visibile se cambi la formattazione della cella).
Quando vuoi creare un nuovo documento di quel tipo allora, partendo da documento VALLE_Master, mandi in esecuzione la Sub NewMyDoc; ti verra' creato un file di nome ZCPIPPO.docx, contenente la numerazione progressiva su 4 cifre prelevata dal file VALLE_Prot.xlsx che verra' contemporaneamente aggiornato.
Quando vuoi salvare col nome definitivo dovrai lanciare la Sub SalvaProt.
Pero' io, per evitare equivoci col file ZCPIPPO.docx eseguirei subito in coda alla Sub NewMyDoc anche la Sub SalvaProt in modo da vedere direttamente il file XXXX.docx; se ti quadra, basta che in fondo alla Sub NewMyDoc, prima di End Sub, aggiungi la riga "Call SalvaProt" (senza virgolette).
Probabilmente si puo' meglio automatizzare, ad esempio inserendo l'esecuzione delle macro direttamente dalla Barra di Accesso Rapido; ma non essendo un utente Word particolarmente furbo lo lascio aperto per altri contrbuti.
Ciao
Registrazione
