Propiedad Application.ActiveSheet (Excel)

Devuelve un objeto que representa la hoja activa (la hoja de la parte superior) en el libro activo o en la ventana o libro especificados. Devuelve Nothing si no hay ninguna hoja activa.

Sintaxis

expresión.ActiveSheet

expresión Variable que representa un objeto Application.

Comentarios

Si no se especifica un calificador de objeto, la propiedad devuelve la hoja activa del libro activo.

Si un libro aparece en más de una ventana, es posible que la propiedad ActiveSheet tenga un valor diferente en cada ventana.

Ejemplo

En este ejemplo se muestra el nombre de la hoja activa.

MsgBox "The name of the active sheet is " & ActiveSheet.Name

Este ejemplo crea una vista previa de impresión de la hoja activa que tiene el número de página en la parte superior de la columna B en cada página.

Sub PrintSheets()

   'Set up your variables.
   Dim iRow As Integer, iRowL As Integer, iPage As Integer
   'Find the last row that contains data.
   iRowL = Cells(Rows.Count, 1).End(xlUp).Row
   
   'Define the print area as the range containing all the data in the first two columns of the current worksheet.
   ActiveSheet.PageSetup.PrintArea = Range("A1:B" & iRowL).Address
   
   'Select all the rows containing data.
   Rows(iRowL).Select
   
   'display the automatic page breaks
   ActiveSheet.DisplayAutomaticPageBreaks = True
   Range("B1").Value = "Page 1"
   
   'After each page break, go to the next cell in column B and write out the page number.
   For iPage = 1 To ActiveSheet.HPageBreaks.Count
      ActiveSheet.HPageBreaks(iPage) _
         .Location.Offset(0, 1).Value = "Page " & iPage + 1
   Next iPage
   
   'Show the print preview, and afterwards remove the page numbers from column B.
   ActiveSheet.PrintPreview
   Columns("B").ClearContents
   Range("A1").Select
End Sub

Soporte técnico y comentarios

¿Tiene preguntas o comentarios sobre VBA para Office o esta documentación? Vea Soporte técnico y comentarios sobre VBA para Office para obtener ayuda sobre las formas en las que puede recibir soporte técnico y enviar comentarios.