Tre macro con codice VBA per creare elenchi puntati più efficienti
della funzione di Word |
Ecco come
incorporare in una macro di un documento Word tre macro che consentono di
creare elenchi puntati in modo più efficiente della funzione fornita dal
programma.
La prima
macro, ALT-P, inserisce ciclicamente tre tipi di punti elenco con prima riga
sporgente a diverse distanze.
La seconda
macro, ALT-Q, fa rientrare il margine sinistro
La terza
macro, ALT-W riduce il rientro del margine sinistro.
Ecco i
passi per incorporare le macro in un documento Word:
(1) Creare
un nuovo documento Word o aprire il documento Word in cui si vuole incorporare
le macro.
(2) Dal
menu selezionare Strumenti > Macro > Registra nuova macro
Nella parte “Nome macro:” immettere il nome ALT_P
Nella parte “Memorizza la macro in…” selezionare il nome del
documento
Solo dopo aver completato le parti sopra indicate, passare
alla parte “Assegna macro a…” cliccare sul bottone con la tastiera
Comparirà un nuovo riquadro
Nella sezione “Salva le modifiche in…” selezionare di nuovo
il nome del documento corrente.
Nella sezione “Nuova combinazione” digitare la combinazione
di tasti ALT + P
Premere quindi in successione i bottoni “ASSEGNA” e “CHIUDI”
Comparirà l’icona di registrazione della macro. Cliccare sul
simbolo di arresto registratore per interrompere la registrazione della macro
(3) Dal
menu selezionare Strumenti > Macro > Macro
Nella finestra “Macro in:” selezionare il nome del documento
corrente Selezionare la macro ALT_P
Premere il pulsante “MODIFICA”
A questo punto sarà visualizzata la macro
Inserire nella macro, tra la riga “Sub ALT_A” e la riga “End
Sub” il seguente codice:
Const
CodiceCerchietto = 9702
Const
CodicePuntoQuadro = 9642
Const
CodicePuntoPieno = 9679
Dim
Paragrafo As Word.Paragraph
'La
variabile Paragrafo viene a comprendere il primo paragrafo della
'selezione
contrassegnata dal cursore
Set
Paragrafo = Selection.Range.Paragraphs(1)
'-------------------------------------------------------------------
'Determina
quale tipo di punto si trova in inizio paragrafo e
'smista di
conseguenza alle istruzioni opportune di cambiamento
'del punto
'-------------------------------------------------------------------
If InStr(1,
Paragrafo.Range.Text, ChrW(CodiceCerchietto)) > 0 Then
GoTo Inserzione_Punto_Quadro
ElseIf
InStr(1, Paragrafo.Range.Text, ChrW(CodicePuntoQuadro)) > 0 Then
GoTo Inserzione_Punto_Pieno
ElseIf
InStr(1, Paragrafo.Range.Text, ChrW(CodicePuntoPieno)) > 0 Then
GoTo Inserzione_Paragrafo_Senza_Punto
ElseIf
InStr(1, Paragrafo.Range.Text, ChrW(CodiceCerchietto)) < 1 And _
InStr(1, Paragrafo.Range.Text,
ChrW(CodicePuntoQuadro)) < 1 And _
InStr(1, Paragrafo.Range.Text,
ChrW(CodicePuntoPieno)) < 1 Then
GoTo Inserzione_Cerchietto
Else
GoTo Inserzione_Paragrafo_Senza_Punto
End If
'------------------------------------------------------------------
Inserzione_Cerchietto:
'------------------------------------------------------------------
'Si porta
all'inizio del paragrafo
Selection.SetRange
Start:=Paragrafo.Range.Start, End:=Paragrafo.Range.Start
'Inserisce
un cerchietto ed una tabulazione
Selection.TypeText
ChrW(CodiceCerchietto) & vbTab
'Si riporta
all'inizio del paragrafo
Selection.SetRange
Start:=Paragrafo.Range.Start, End:=Paragrafo.Range.Start
'Si sposta
immediatamente dopo la tabulazione
Selection.MoveRight unit:=wdCharacter, Count:=2,
Extend:=wdMove
'Inserisce
un rientro prima riga di 0.5 cm
With Paragrafo.Range.ParagraphFormat
.LeftIndent = .LeftIndent + .FirstLineIndent
.LeftIndent = .LeftIndent + CentimetersToPoints(0.25)
.FirstLineIndent = -CentimetersToPoints(0.25)
End With
GoTo Fine_Routine
'-----------------------------------------------------------------
Inserzione_Punto_Quadro:
'-----------------------------------------------------------------
'Elimina il
carattere cerchietto
If InStr(1,
Paragrafo.Range.Text, ChrW(CodiceCerchietto)) > 0 Then
Paragrafo.Range.Characters(InStr(1,
Paragrafo.Range.Text, ChrW(CodiceCerchietto))).Delete
End If
'Elimina il
carattere tabulazione
If InStr(1, Paragrafo.Range.Text, vbTab) > 0 Then
Paragrafo.Range.Characters(InStr(1,
Paragrafo.Range.Text, vbTab)).Delete
End If
'Si porta
all'inizio del paragrafo
Selection.SetRange
Start:=Paragrafo.Range.Start, End:=Paragrafo.Range.Start
'Inserisce
un punto quadro ed una tabulazione
Selection.TypeText
ChrW(CodicePuntoQuadro) & vbTab
'Si riporta
all'inizio del paragrafo
Selection.SetRange
Start:=Paragrafo.Range.Start, End:=Paragrafo.Range.Start
'Sposta il
cursore verso destra di due posizioni, per posizionarlo subito dopo la
tabulazione
Selection.MoveRight unit:=wdCharacter, Count:=2,
Extend:=wdMove
'Inserisce
un rientro prima riga di 0.5 cm
With Paragrafo.Range.ParagraphFormat
.LeftIndent = .LeftIndent + .FirstLineIndent
.LeftIndent = .LeftIndent + CentimetersToPoints(0.5)
.FirstLineIndent = -CentimetersToPoints(0.5)
End With
GoTo Fine_Routine
'-----------------------------------------------------------------
Inserzione_Punto_Pieno:
'-----------------------------------------------------------------
'Elimina il
carattere punto quadro
If InStr(1,
Paragrafo.Range.Text, ChrW(CodicePuntoQuadro)) > 0 Then
Paragrafo.Range.Characters(InStr(1,
Paragrafo.Range.Text, ChrW(CodicePuntoQuadro))).Delete
End If
'Elimina il
carattere tabulazione
If InStr(1, Paragrafo.Range.Text, vbTab) > 0 Then
Paragrafo.Range.Characters(InStr(1,
Paragrafo.Range.Text, vbTab)).Delete
End If
'Si porta
all'inizio del paragrafo
Selection.SetRange
Start:=Paragrafo.Range.Start, End:=Paragrafo.Range.Start
'Inserisce
un punto pieno ed una tabulazione
Selection.TypeText ChrW(CodicePuntoPieno) & vbTab
'Si riporta
all'inizio del paragrafo
Selection.SetRange
Start:=Paragrafo.Range.Start, End:=Paragrafo.Range.Start
'Sposta il
cursore verso destra di due posizioni, per posizionarlo subito dopo la
tabulazione
Selection.MoveRight unit:=wdCharacter, Count:=2,
Extend:=wdMove
'Inserisce
un rientro prima riga di 1 cm
With Paragrafo.Range.ParagraphFormat
.LeftIndent = .LeftIndent + .FirstLineIndent
.LeftIndent = .LeftIndent + CentimetersToPoints(1)
.FirstLineIndent = -CentimetersToPoints(1)
End With
GoTo Fine_Routine
'-----------------------------------------------------------------
Inserzione_Paragrafo_Senza_Punto:
'-----------------------------------------------------------------
'Elimina il
carattere punto pieno
If InStr(1,
Paragrafo.Range.Text, ChrW(CodicePuntoPieno)) > 0 Then
Paragrafo.Range.Characters(InStr(1,
Paragrafo.Range.Text, ChrW(CodicePuntoPieno))).Delete
End If
'Elimina il
carattere tabulazione
If InStr(1, Paragrafo.Range.Text, vbTab) > 0 Then
Paragrafo.Range.Characters(InStr(1,
Paragrafo.Range.Text, vbTab)).Delete
End If
'Si porta
all'inizio del paragrafo
Selection.SetRange
Start:=Paragrafo.Range.Start, End:=Paragrafo.Range.Start
'Elimina il
rientro prima riga
With Paragrafo.Range.ParagraphFormat
.LeftIndent = .LeftIndent + .FirstLineIndent
.FirstLineIndent = 0
End With
GoTo Fine_Routine
Fine_Routine:
(4) Creare
un’altra macro, ALT-Q, con la stessa modalità utilizzata ai punti (2) e (3) e inserire,
nella routine, il codice seguente:
Dim Paragrafo As Paragraph
Application.ScreenUpdating = False
For Each Paragrafo In Selection.Range.Paragraphs
Paragrafo.Range.ParagraphFormat.LeftIndent =
Paragrafo.Range.ParagraphFormat.LeftIndent + CentimetersToPoints(0.25)
Next
Paragrafo
Application.ScreenUpdating
= True
(5) Creare
un’altra macro, ALT-W, con la stessa modalità utilizzata ai punti (2) e (3) e inserire,
nella routine, il codice seguente:
Dim Paragrafo As Paragraph
Application.ScreenUpdating = False
For Each Paragrafo In Selection.Range.Paragraphs
Paragrafo.Range.ParagraphFormat.LeftIndent =
Paragrafo.Range.ParagraphFormat.LeftIndent - CentimetersToPoints(0.25)
Next
Paragrafo
Application.ScreenUpdating
= True
(6) Buon
lavoro con i punti elenco!