Crea sito

 

 

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!