Buenos días,
Tengo un archivo xlsm realizado en Excel , que contiene unas macros que a partir de uno s datos en la hoja de cálculo, abren otro archivo de excel, transfiere datos, y posteriormente graba los dos.
El problema, es que al ejecutarlo con libreOffice (he probado con la última versión 6.4 y anteriores), la primera vez si que funciona la macro. Pero cuando cierro el archivo y lo vuelvo a abrir, ya no funciona la macro, es como si se hubiera desconfigurado o borrado al salvar el archivo (que se guarda con el mismo nombre y formato…)
No se que puede estar pasando…
**Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CeldaActual As String
Dim nombre_archivo As String
' AQUI MOSTRAMOS UN MENSAJE DICIENDO SI QUIERE O NO CONTINUAR PARA GENERAR EL ESTADILLO
Dim Pregunta As String
CeldaActual = ActiveCell.Address
'Si se elige una celda entre el rango A10:A17
If Not Intersect(Target, Range("F3:AJ3")) Is Nothing Then
'VALIDACION PARA INTRODUCIR EL TURNO
Dim turno
x:
turno = UCase(InputBox(“Introduzca el turno para estadillo. " & vbCrLf & " Introduce M (mañana) , T (tarde) o N (noche)”, “TURNO”))
If turno = "M" Or turno = "T" Or turno = "N" Then
'Si el día es menor que 10, para que el archivo quede con un 0 delante , modificamos el nombre
If (ActiveCell.Text > 9) Then
nombre_archivo = ActiveSheet.Name & "_" & ActiveCell.Text & "_" & turno
Else
nombre_archivo = ActiveSheet.Name & "_0" & ActiveCell.Text & "_" & turno
End If
'Creamos una copia del estadillo con el nombre de archivo según la celda pulsada
Copiar_Libro (nombre_archivo)
Else
Pregunta = MsgBox("El turno debe ser :" & vbCrLf & vbCrLf & " M para MAÑANA" & vbCrLf & " T para TARDE" & vbCrLf & " N para NOCHE" & vbCrLf & vbCrLf & " Si no desea continuar generando el estadillo pulse Cancelar", vbYesNo + vbQuestion, "Atención")
If Pregunta = vbYes Then
GoTo x
Else
Exit Sub
End If
End If
End If
End Sub
Public Sub Copiar_Libro(ByVal nombre_archivo As String)
'Definir objetos a utilizar
Dim wbDestino As Workbook
Dim wbOrigen As Workbook
Dim wsOrigen As Excel.Worksheet
Dim wsDestino As Excel.Worksheet
Dim direccion_celda As String
Dim columna As Integer
Dim fila As Integer
Dim i As Integer
Dim j As Integer
Dim funcionarios_total, funcionarios_quedan, funcionarios_faltan As Integer
Dim temporal As String
direccion_celda = ActiveCell.Address
columna = ActiveCell.Column
fila = ActiveCell.Row
Set wbOrigen = ActiveWorkbook
' Hojas de origen y destino
Set wsOrigen = wbOrigen.Worksheets(ActiveSheet.Name)
MsgBox "PUMA 30 -> " & wsOrigen.Cells(9, columna).Value & vbCrLf & "PUMA 31 -> " & wsOrigen.Cells(26, columna).Value & vbCrLf & "PUMA 34 -> " & wsOrigen.Cells(44, columna).Value & vbCrLf & "PUMA 37 -> " & wsOrigen.Cells(61, columna).Value & vbCrLf & "TOTAL -> " & wsOrigen.Cells(62, columna).Value, vbOKOnly, "NUMERICO OPERATIVO"
' MsgBox "Has seleccionado la celda " & direccion_celda & " y el texto para el archivo será " & "ESTADILLO" & "_" & ActiveSheet.Name & ActiveCell.Text, vbInformation, "EXCELeINFO"
'Indicar el libro de Excel destino
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "\" & "ESTADILLO.xlsm")
'Creamos el nuevo archivo con el nombre que queremos, en este caso es el día (que vendrá en la selda seleccionada, y con el nombre de la hoja)
'wbDestino.SaveAs Filename:=wbDestino.Path & "\" & "ESTADILLO" & "_" & nombre_archivo
'CREACION DE LA CARPETA SI NO ESTA
Dim carpeta_destino As String
carpeta_destino = wbDestino.Path & "\" & Left(nombre_archivo, 7)
’ MsgBox carpeta_destino, vbInformation, “Kutools for Excel”
Dim fdObj As Object
Application.ScreenUpdating = False
Set fdObj = CreateObject("Scripting.FileSystemObject")
If Not fdObj.FolderExists(carpeta_destino) Then
fdObj.CreateFolder (carpeta_destino)
' MsgBox "It has been created.", vbInformation, "Kutools for Excel"
End If
Application.ScreenUpdating = True
' FIN DE LA CREACION DE LA CARPETA
'Si lo hacemos por carpetas con el mes
wbDestino.SaveAs Filename:=carpeta_destino & "\" & "ESTADILLO" & "_" & nombre_archivo & ".xlsm"
' MsgBox "nombre Completo " & wbDestino.FullName, vbInformation, "EXCELeINFO"
'
Set wsDestino = wbDestino.Worksheets("ESTADILLO PEQUEÑO")
'Se copian los datos de ese día al estadillo pequeño
'Set wsDestino = Workbooks.Open(wbDestino.FullName).Worksheets("ESTADILLO PEQUEÑO")
'MsgBox "VALOR CELDA ORIGEN " & wsOrigen.Cells(fila, columna), vbInformation, "EXCELeINFO"
' MsgBox "FILA Y COLUMNA " & fila & " " & columna, vbInformation, "EXCELeINFO"
' MsgBox "Nombre de la hoja" & wsOrigen.Name, vbInformation, "EXCELeINFO"
j = 11 ' Por que es donde empiezan los nombres en el estadillo pequeño
'Con la i recorremos las filas de la sabana
For i = 4 To 60
'Si la celda i (que es donde tiene que estar codificada la incidencia) de la columna seleccionada no es un numero entonces
If (Not IsEmpty(wsOrigen.Cells(i, columna))) And (Not IsEmpty(wsOrigen.Cells(i, 4))) Then
'MsgBox "VALOR DEL DIA '" & wsOrigen.Cells(i, columna) & "' VALOR DEL FUNCIONARIO '" & wsOrigen.Cells(i, 4) & "'", vbInformation, "EXCELeINFO"
'Se copia nombre del funcionario
wsDestino.Cells(j, "B").Value = wsOrigen.Cells(i, 4).Value
'Se copia el motivo
wsDestino.Cells(j, "F").Value = UCase(wsOrigen.Cells(i, columna).Value)
j = j + 1
End If
Next
'Ponemos la fecha en el estadillo pequeño
wsDestino.Cells(5, "D").Value = wsOrigen.Cells(fila, columna).Value
'Ponemos el turno en el estadillo pequeño
Dim turno As String
turno = Right(nombre_archivo, 1)
Select Case turno
Case "M"
wsDestino.Cells(5, "B").Value = "MAÑANA"
Case "T"
wsDestino.Cells(5, "B").Value = "TARDE"
Case Else
wsDestino.Cells(5, "B").Value = "NOCHE"
End Select
funcionarios_total = wsDestino.Cells(8, "F").Value
funcionarios_quedan = wsDestino.Cells(32, "F").Value
funcionarios_faltan = funcionarios_total - funcionarios_quedan
MsgBox "De los " & funcionarios_total & " funcionarios, quedan " & funcionarios_quedan & vbCrLf & "por lo que faltan " & funcionarios_faltan, vbOKOnly, "NUMERICO OPERATIVO"
'Cerramos el libro
wbDestino.Save
wsDestino.Activate
'wbDestino.Close (True)
End Sub
**