[RESUELTO] Macro que funciona en solo algunos casos

[userpepe]

Muy buenas a todos.

He estado practicando con las macros y he preparado una muy sencilla.

Código: Seleccionar todo

Sub AJUSTES()
'--------------------------------------------------------------------------------------------
Dim oHoja As Object
Dim oCell4 As Object
Dim oCell2 As Object
Dim a As Integer
Dim b As Integer

   oHoja = ThisComponent.getCurrentController.getActiveSheet()

    For a = 3 to 700
   '   MsgBox oCell4.getType() '0: Vacia - 1: Número - 2: Texto - 3: Fórmula
         oCell4 = oHoja.getCellByPosition(4,a)
         oCell2 = oHoja.getCellByPosition(2,a)

        If oCell4.Type = EMPTY Then
   			
    		Call CeldaElimina(a, "E")
   	     		 
        End If
        
         If oCell2.Type = EMPTY Then
   			
    		Call CeldaElimina(a, "C")
   		 
      	End If
    Next a 

End Sub
'--------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------

He comprobado que funciona perfectamente pero en mi casa...pero la pruebo en otros equipos y me da un error:

Error de ejecución de BASIC.
Se ha producido una excepción
Type: com.sun.star.lang.IndexOutOfBoundsException
Message: .

Os agradecería que me ayudaséis a saber por qué ocurre esto.

Un saludo y gracias

[userpepe]

Anexo:

El error me lo marca en esta línea

oCell4 = oHoja.getCellByPosition(4,a)

[FJCC-ES]

¿Qué valor tiene la variable a cuando la macro falla? Puede ver el valor si el código incluye el comando ON ERROR:

Código: Seleccionar todo

Sub AJUSTES()
'--------------------------------------------------------------------------------------------
Dim oHoja As Object
Dim oCell4 As Object
Dim oCell2 As Object
Dim a As Integer
Dim b As Integer
On ERROR GoTo Handler  ' fjcc ###########
   oHoja = ThisComponent.getCurrentController.getActiveSheet()

    For a = 3 to 700
   '   MsgBox oCell4.getType() '0: Vacia - 1: Número - 2: Texto - 3: Fórmula
         oCell4 = oHoja.getCellByPosition(4,a)
         oCell2 = oHoja.getCellByPosition(2,a)

        If oCell4.Type = EMPTY Then
            
          Call CeldaElimina(a, "E")
             
        End If
       
         If oCell2.Type = EMPTY Then
            
          Call CeldaElimina(a, "C")
         
         End If
    Next a
print "normal"  'fjcc ###########
Exit Sub  'fjcc ###########
Handler: print "Error! a = ", a  'fjcc ###########
End Sub

¿Puede subir un archivo con datos que producen el error y con el código CeldaElimina()?

[userpepe]

Hola FJCC-Es;

Primero darte las gracias por contestar.

El codigo de celda elimina es

Código: Seleccionar todo

Sub CeldaElimina(c As Integer, oCol As String)
'--------------------------------------------------------------------------------------------
   ' Se elimina la celda; otras celdas ocupan el lugar que queda vacío
   Dim oRango As Object
   Dim oHoja As Object
   Dim oAddress As New com.sun.star.table.CellRangeAddress
   Dim cDireccion As String
   Dim cRango as Object
  
   oHoja = ThisComponent.getCurrentController.getActiveSheet() 
   cRango = oHoja.getCellRangeByName(oCol & c+1)
  ' MsgBox(cRango.setString)
   cDireccion = "a"
 '  oRango = Rango(oHoja, cRango)
   oAddress = cRango.RangeAddress
   
   If IsMissing(cDireccion) Then cDireccion = ""
   Select Case LCase(cDireccion)
   Case "", "a", "arriba", "up"
      oHoja.removeRange(oAddress, com.sun.star.sheet.CellDeleteMode.UP)
 '  Case "i", "izquierda", "left"
 '     oHoja.removeRange(oAddress, com.sun.star.sheet.CellDeleteMode.LEFT)
 '  Case "f", "filas", "rows"
 '     oHoja.removeRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS)
 '  Case "c", "columnas", "columns"
 '     oHoja.removeRange(oAddress, com.sun.star.sheet.CellDeleteMode.COLUMNS)
   End Select
End Sub
'--------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------

Aplicando tus correcciones me da error en el valor de a = 4

[FJCC-ES]

La macro no me da error pero deja muchas celdas vacías. Eso ocurre cuando hay dos celdas vacías. Por ejemplo, el bucle empieza en la celda C4. Ve que está vacía y llama CeldaElimina(), eliminando C4 y moviendo C5 hasta arriba al a posición C4. Pero C5 esta vacía, así que C4 se queda vacía.
Este código empieza en la fila 701 (a=700), mueve hasta arriba y no deja celdas vacías entre las celdas con datos.

Código: Seleccionar todo

Sub AJUSTES()
'--------------------------------------------------------------------------------------------
Dim oHoja As Object
Dim oCell4 As Object
Dim oCell2 As Object
Dim a As Integer
Dim b As Integer
On ERROR GoTo Handler  ' fjcc ###########
   oHoja = ThisComponent.getCurrentController.getActiveSheet()

    For a = 700 to 3 step -1 ' fjcc  #########
   '   MsgBox oCell4.getType() '0: Vacia - 1: Número - 2: Texto - 3: Fórmula
         oCell4 = oHoja.getCellByPosition(4,a)
         oCell2 = oHoja.getCellByPosition(2,a)

        If oCell4.Type = EMPTY Then
           
          Call CeldaElimina(a, "E")
             
        End If
       
         If oCell2.Type = EMPTY Then
           
          Call CeldaElimina(a, "C")
         
         End If
    Next a
print "normal"  'fjcc ###########
Exit Sub  'fjcc ###########
Handler: print "Error! a = ", a  'fjcc ###########
End Sub

Este hace lo mismo pero es más rapido.

Código: Seleccionar todo

Sub Ajustes_2
oHoja = ThisComponent.getCurrentController.getActiveSheet()

oColumnaC = oHoja.getCellRangeByName("C4:C701")
oVacias = oColumnaC.queryEmptyCells()
If oVacias.Count > 0 Then
	For i = oVacias.Count -1 to 0 step -1
		oCeldas = oVacias.getByIndex(i)
		oHoja.removeRange(oCeldas.RangeAddress, com.sun.star.sheet.CellDeleteMode.UP)
	next i
End If

oColumnaE = oHoja.getCellRangeByName("E4:E701")
oVacias = oColumnaE.queryEmptyCells()
If oVacias.Count > 0 Then
	For i = oVacias.Count -1 to 0 step -1
		oCeldas = oVacias.getByIndex(i)
		oHoja.removeRange(oCeldas.RangeAddress, com.sun.star.sheet.CellDeleteMode.UP)
	next i
End If
End Sub

[userpepe]

Muchas Gracias !!!
Me queda mucho por aprender aún...

Funciona Perfectamente