Agenda en Excel

eduardopo · el 18 de junio

Buen dia estimados:

comora se pueden dar cuenta soy nuevo en el foro, pero queria saber si me puedne ayudar con un promebla que tengo.

Estoy hacuiendo una agenda en excel utilizando el control de calendario, pero al momento que me toma el balor de la celda de ancleje del calendrio para crear una hoja nueva me da un problema, tambien habia hecho un ciclo paque me comprobara si la hoja ya existia solo me enviara a ella y desplegara un mensaje que dijera la hoja ya existe, el codigo que e usado es el siguente:

Sub CrearHoja()

Dim titulo As String

''se llama la funcion

If ExisteHoja Then

MsgBox "La tarea ya Existe."

titulo = Sheets("Calendario").Range("c3") + ""

Worksheets(titulo).Select

Else

MsgBox "Creando Tarea."

''copia la hoja llamada Plantilla y la renombra de acuerdo al valor de la celda C3 en la Hoja Calendario

Sheets("Plantilla").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)

''toma la hoja activa y le da el nombre de la celda C3 de la hoja calendario

ActiveSheet.Name = Format(Sheets("Calendario").Range("c3").Value, "dd-mm-yyyy")

''Sheets.Add().Name = Year(ActiveCell) & Format(Month(ActiveCell), "00") & Format(Day(ActiveCell), "00")

End If

End Sub

Function ExisteHoja() As Boolean ''funcion que comprueba si ya existe la hoja o tarea

''le asigna el balor de la celda c3 a una variable para realizar la comprobacion

titulo = Sheets("Calendario").Range("c3") + ""

'inici ciclo en el cual carga todas la hojas que existen el el libro

For h = 1 To Sheets.Count

''realiza la comprobacion de la tarea que se quiere crear contra las que ya existen

If Sheets(h).Name = titulo Then

''si ya existe termina la funcion y no crea la hoja

ExisteHoja = True

Exit Function

Else

ExisteHoja = False ''si no existe procede a crearla

End If

Next h

End Function

De antemano gracias por su ayuda.

Antoni · el 18 de junio

Hola:

Sustituye todo tu código por:

Sub CrearHoja()


Hoja = Format(Sheets("Calendario").Range("c3").Value, "dd-mm-yyyy")


On Error GoTo CrearTarea

   Worksheets(Hoja).Select

   MsgBox "La tarea ya existe"

   Exit Sub


CrearTarea:

   Sheets("Plantilla").Copy After:=Sheets(Sheets.Count)

   ActiveSheet.Name = Hoja


End Sub[/CODE]