¿Alguien ha pensado que crear un calendario en excel tenia que ser mas fácil?. Yo también. Aquí tenéis una macro de excel para crearos un calendario del mes que queráis y del año que queráis.

Para utilizar esta macro debéis ir a Herramientas / Macro /Editor de Visual Basic.

Menú Insertar / Modulo y pegar el texto siguiente.

Luego ya solo ejecutar la macro y te lo hace todo solo para el mes que le pongas, por ejemplo, si quieres para este mes has de poner en el InputBox "03/2008" (sin comillas).

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Sub Crea_Calendario()
  2.  
  3. ' Desprotege la hoja si tienes un calendario previo para prevenir el error.
  4. ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
  5. Scenarios:=False
  6. 'Previene el parpadeo de la ventana mientras se crea el calendario.
  7. Application.ScreenUpdating = False
  8. ' Control de errores.
  9. On Error GoTo MyErrorTrap
  10. ' Limpia el area a1:g14 incluyendo cualquier calendario previo.
  11. Range("a1:g14").Clear
  12. ' Usa un InputBox para pedir el mes y año deseado y ponerlo en la variable MyInput.
  13. MyInput = InputBox("Escribe el mes y el año para el calendario en formato 01/2008 ")
  14. ' Permite al usuario terminar la macro Cancelando el InputBox.
  15. If MyInput = "" Then Exit Sub
  16. ' Coge el valor del día del comienzo del mes.
  17. StartDay = DateValue(MyInput)
  18. If Day(StartDay) <> 1 Then
  19. StartDay = DateValue(Month(StartDay) & "/1/" & _
  20. Year(StartDay))
  21. End If
  22.  Range("a1").NumberFormat = "mmmm yyyy"
  23. ' Formatea el mes y el año.
  24. With Range("a1:g1")
  25. .HorizontalAlignment = xlCenterAcrossSelection
  26. .VerticalAlignment = xlCenter
  27. .Font.Size = 18
  28. .Font.Bold = True
  29. .RowHeight = 35
  30. End With
  31. ' Formatea los días de la semana.
  32. With Range("a2:g2")
  33. .ColumnWidth = 18
  34. .VerticalAlignment = xlCenter
  35. .HorizontalAlignment = xlCenter
  36. .VerticalAlignment = xlCenter
  37. .Orientation = xlHorizontal
  38. .Font.Size = 12
  39. .Font.Bold = True
  40. .RowHeight = 20
  41. End With
  42. ' Pone los días de la semana en a2:g2.
  43. Range("a2") = "Lunes"
  44. Range("b2") = "Martes"
  45. Range("c2") = "Miercoles"
  46. Range("d2") = "Jueves"
  47. Range("e2") = "Viernes"
  48. Range("f2") = "Sabado"
  49. Range("g2") = "Domingo"
  50. ' Formatea las celdas a3:g7 para los días.
  51. With Range("a3:g8")
  52. .HorizontalAlignment = xlRight
  53. .VerticalAlignment = xlTop
  54. .Font.Size = 18
  55. .Font.Bold = True
  56. .RowHeight = 21
  57. End With
  58. ' Pone el mes y año indicado en la variable MyInput en "a1".
  59. Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
  60. ' Pone la variable y coge el dia de la semana en el que el mes empieza.
  61. DayofWeek = Weekday(StartDay)
  62. ' Separa las variables de mes y año en dos variables
  63. CurYear = Year(StartDay)
  64. CurMonth = Month(StartDay)
  65. ' Calcula el primer día del mes siguiente.
  66. FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
  67. ' Pone un "1" en la celda del primer día del mes escogido
  68. Select Case DayofWeek
  69. Case 1
  70. Range("g3").Value = 1 ' g3 porque empieza por domingo
  71. Case 2
  72. Range("a3").Value = 1
  73. Case 3
  74. Range("b3").Value = 1
  75. Case 4
  76. Range("c3").Value = 1
  77. Case 5
  78. Range("d3").Value = 1
  79. Case 6
  80. Range("e3").Value = 1
  81. Case 7
  82. Range("f3").Value = 1
  83. End Select
  84. ' Loop para el rango a3:g8 incrementando en 1 a partir del primer "1".
  85. For Each cell In Range("a3:g8")
  86. RowCell = cell.Row
  87. ColCell = cell.Column
  88. ' Si "1" está en la primera columna.
  89. If cell.Column = 1 And cell.Row = 3 Then
  90. ' Si NO está en la primera columna.
  91. ElseIf cell.Column <> 1 Then
  92. If cell.Offset(0, -1).Value>= 1 Then
  93. cell.Value = cell.Offset(0, -1).Value + 1
  94. ' Se detiene cuando el el último dia del mes se ha colocado.
  95. If cell.Value> (FinalDay - StartDay) Then
  96. cell.Value = ""
  97. Exit For
  98. End If
  99. End If
  100. ' Solo si la actual celda no está en fila 3 y está en la columna 1.
  101. ElseIf cell.Row> 3 And cell.Column = 1 Then
  102. cell.Value = cell.Offset(-1, 6).Value + 1
  103. ' Se detiene cuando el el último dia del mes se ha colocado.
  104. If cell.Value> (FinalDay - StartDay) Then
  105. cell.Value = ""
  106. Exit For
  107. End If
  108. End If
  109. Next
  110.  
  111. ' Crea las celdas de entrada de datos y las formatea.
  112. For x = 0 To 5
  113. Range("A4").Offset(x * 2, 0).EntireRow.Insert
  114. With Range("A4:G4").Offset(x * 2, 0)
  115. .RowHeight = 65
  116. .HorizontalAlignment = xlCenter
  117. .VerticalAlignment = xlTop
  118. .WrapText = True
  119. .Font.Size = 10
  120. .Font.Bold = False
  121. ' Desbloquea estas celdas para insertar texto después porque
  122. ' la hoja estará protegida.
  123. .Locked = False
  124. End With
  125. ' Crea el borde alrededor de los días.
  126. With Range("A3").Offset(x * 2, 0).Resize(2, _
  127. 7).Borders(xlLeft)
  128. .Weight = xlThick
  129. .ColorIndex = xlAutomatic
  130. End With
  131.  
  132. With Range("A3").Offset(x * 2, 0).Resize(2, _
  133. 7).Borders(xlRight)
  134. .Weight = xlThick
  135. .ColorIndex = xlAutomatic
  136. End With
  137. Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
  138. Weight:=xlThick, ColorIndex:=xlAutomatic
  139. Next
  140. If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
  141. .Resize(2, 8).EntireRow.Delete
  142. ' Elimina las lineas del grid.
  143. ActiveWindow.DisplayGridlines = False
  144. ' Protege la hoja para prevenir la sobre escritura de los días.
  145. ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
  146. Scenarios:=True
  147. ' Redimensiona la ventana para ver todo el calendario.
  148. ActiveWindow.WindowState = xlMaximized
  149. ActiveWindow.ScrollRow = 1
  150.  
  151. ' Permitimos a la ventana reescribirse para ver el calendario.
  152. Application.ScreenUpdating = True
  153. ' Si no ha ocurrido ningún error aquí acaba la Macro
  154. Exit Sub
  155. ' Si ha dado error al introducir los datos te muestra un mensaje y te
  156. ' muestra de nuevo el InputBox para que vuelvas a introducir la fecha.
  157. MyErrorTrap:
  158. MsgBox "No has introducido el mes y el año correctamente." _
  159. & Chr(13) & "Escribe el mes correctamente" _
  160. & Chr(13) & "y 4 digitos para el año"
  161. MyInput = InputBox("Escribe el mes y el año correctamente para el calendario")
  162. If MyInput = "" Then Exit Sub
  163. Resume
  164. End Sub

Si hemos creado una macro en excel y la quitamos al volver a abrir el documento sigue apareciendo una molesta ventana que dice que el documento tiene macros cuando no existe ninguna macro:

Menu Herramientas, Macro, Editor Visual Basic, menú ver explorador de proyectos, botón derecho sobre cada modulo y quitar.

Si nos preguntar guardar y no lo queremos le decimos que no.

La próxima vez que abramos el documento ya no nos preguntará si queremos habilitar los macros.


Vota este artículo:
1 Estrella2 Estrellas3 Estrellas4 Estrellas5 Estrellas (1 votes, average: 5,00 out of 5)
Loading ... Loading ...

Posts anterior y posterior:
«
»


Posts Relacionados: