Esempi

Esempi di automazioni su oggetti Excel

Creiamo un nuovo modulo di codice in VBA e proviamo ad eseguire le routine seguendo i suggerimenti.
Esempio 1
L'esempio crea una riga diagonale di asterischi dalla cella A1 a J10 sul foglio di lavoro attivo.
	Sub Diagonale_Asterischi()
	   Set Z = Range("A1:J10")
	   Nr = Z.Rows.Count
	   For i = 1 To Nr
	   Z(i, i).Value = "*"
	   Next
	End Sub
	
Esempio 2
Inseriamo la funzione "=CASUALE()" in cella "D2" ed eseguiamo la routine seguente che copia la formula in basso.
	Sub Copia_in_Basso()
	   Range("D2").Select
	   Selection.AutoFill Destination:=Range("D2:D8"), _ 
	   Type:=xlFillDefault
	   Range("D2:D8").Select
	End Sub
	
Esempio 3
Inseriamo dei valori nella prima riga di foglio1. La routine copia la prima riga da foglio1 sulla seconda di foglio2.
	Sub Sposta_riga()
	    Worksheets("Foglio1").Select
	    Rows("1:1").Select
	    Selection.Copy
	    Worksheets("Foglio2").Select
	    Rows("2:2").Select
	    ActiveSheet.Paste
	End Sub 
	
Esempio 4
L'esempio blocca la prima riga del foglio attivo.
	Sub Blocca_riga()
	    Rows("2:2").Select
	    ActiveWindow.FreezePanes = True
	End Sub
	
Esempio 5
L'esempio crea un nuovo foglio di lavoro lo nomina e lo imposta come ultimo foglio.
	Sub CreaFoglio()
	    Sheets.Add
	    ActiveSheet.Select
	    ActiveSheet.Name = "FoglioProva" & Worksheets.Count
	    Sheets("FoglioProva" & Worksheets.Count).Select
	    Sheets("FoglioProva" & Worksheets.Count).Move _
	    After:=Sheets(Worksheets.Count)
	End Sub
	
Esempio 6
L'esempio mostra i nomi delle finestre Excel attive e delle cartelle attive.
	Sub MostraFin()
	   For each finest in application.Windows
	      Msgbox finest.caption & " " & finest.parent.name
	   Next
	End Sub

	
Esempio 7
La routine conta le cartelle e le finestre di applicazione Excel attive, inoltre per ogni cartella conta le finestre attive.
	Sub ScorreFin()
	   Const Messiniz = "La cartella n. "
	   Dim i as integer 
	   Dim j as integer
	   Dim Mess as string
	   Dim NumCart as integer
	   Dim NumFines as integer	
	   NumFines = Windows.count    'conta le finestre totali
	   NumCart = Workbooks.count   'conta le cartelle totali
	   Msgbox " Finestre Totali: " & NumFines
	   Msgbox "Cartelle Totali: " & NumCart
	   For i=1 to NumCart	'scorre le cartelle
	      With WorkBooks(i)
	         Mess = MessIniz & i
	         'finestre della cartella in esame
	         NumFines = .Windows.count		
	         If NumFines=1 then
	            Msgbox Mess & " ha una sola finestra"
	         Else
	            Msgbox Mess & " ha le seguenti finestre"
	            For j=1 to  NumFines
	               Msgbox .Windows(j).caption
	            Next
	         End if
	      End with
	   Next		 
	End Sub
	
Esempio 8
La routine mostra tutti i fogli della cartella attiva.
	Sub ScorreFin1()
	   For i = 1 To Worksheets.Count
	       With Worksheets(i)
	          .Activate
	          MsgBox .Name
	       End With
	    Next
	End Sub
	
Esempio 9
L'esempio parte dal foglio attivo e mostra il nome dei fogli fino all'ultimo, poi riparte dal primo fino al foglio attivo.
	Sub ScorreFogli()
	   indatt = ActiveSheet.Index
	   nflav = Sheets.Count
	   For i = indatt To nflav
	      With Sheets(i)
	         .Activate
	         MsgBox .Name
	      End With
	   Next
	   For i = 1 To indatt - 1
	      With Sheets(i)
	          .Activate
	          MsgBox .Name
	      End With
	   Next
	   Sheets(i).Activate
	End Sub
	
Esempio 10
In colonna "B" č riportata una serie di valori. Del primo valore sono calcolati gli elevamenti alla seconda, alla terza alla quarta e disposti a destra della prima cella. La routine copia in basso le formule disposte sulla prima riga per quanti sono i valori della colonna di destra.
UsedRange: Restituisce un oggetto Range, che rappresenta l'intervallo utilizzato dal foglio di lavoro attivo. Proprietą di sola lettura.
	Sub CopiaFormule()
	   ActiveWorkbook.Names.Add "Rigaform", RefersToR1C1:= _
	   ActiveSheet.UsedRange.Range(Cells(1, 2), _ 
	   Cells(1, 4))
	   Application.Goto reference:="Rigaform"
	   ActiveCell.Offset(0, -1).Select
	   Selection.End(xlDown).Select
	   ActiveCell.Offset(0, 3).Select
	   ActiveWorkbook.Names.Add "ultimacella", _ 
	   RefersToR1C1:=ActiveCell
	   Range("Rigaform").Select
	   Selection.Copy
	   Range("Rigaform:ultimacella").Select
	   ActiveSheet.Paste
	   Application.CutCopyMode = False
	   ActiveWorkbook.Names("ultimacella").Delete
	End Sub
	
Esempio 11
Variante del’esempio sopra.
	Sub CopiaFormule1()
	   ActiveWorkbook.Names.Add "Rigaform", RefersToR1C1:= _
	   ActiveSheet.UsedRange.Range(Cells(1, 2), Cells(1, 4))
	   Application.Goto Reference:="Rigaform"
	   NumRiga = Selection.Offset(0, -1).End(xlDown).Row
	   NumCol = Selection.End(xlToRight).Column
	   Set Primacella = Range("Rigaform").Cells(1, 1)
	   Set Ultimacella = Cells(NumRiga, NumCol)
	   Selection.Copy
	   Range(Primacella, Ultimacella).Select
	   ActiveSheet.Paste
	   Application.CutCopyMode = False
	End Sub
	

Cognolato Studio © 2004