Ver Mensaje Individual
  #2 (permalink)  
Antiguo 04/04/2006, 07:26
Avatar de niconico
niconico
 
Fecha de Ingreso: enero-2006
Mensajes: 166
Antigüedad: 18 años, 4 meses
Puntos: 0
He dado con la solución, he hecho dos modificaciones: declarar las variables dentro de cada procedimiento y añadir un checkbox1.value=true.
El código:
Código:
Private Sub CheckBox1_Click()
Dim Evita_copia As Boolean
Evita_copia = False
Application.ScreenUpdating = False

'Creamos la variable "posicion", que contendrá el rango actual donde estamos situados,
'es decir, si estamos en F16, la variable "posicion" contendrá esa celda
posicion = ActiveCell.Address
'Si el checkbox lo ponemos como true (ON), que haga lo siguiente
If CheckBox1.Value = True Then
'Seleccionamos el rango que queremos copiar
Range("B17:I17").Select
'Lo copiamos
Selection.Copy
'Seleccionamos el rango de destino de la copia
Range("B38:I38").Select
'Lo pegamos
ActiveSheet.Paste
'Desactivamos el área de selección de copia y pegado
Application.CutCopyMode = False
'Nos desplazamos a la celda de origen, es decir, allí donde
'estábamos inicialmente (por eso hemos guardado en "posicion", la celda)
Range(posicion).Select
'Si el checkbox está como false (OFF), que borre el contenido de B1 a B3
Else
Evita_copia = True
'Seleccionamos el rango que queremos borrar
Range("B38:I38").Select
'Borramos el contenido
Selection.ClearContents
'Nos desplazamos a la celda de origen, es decir, allí donde
'estábamos inicialmente (por eso hemos guardado en "posicion", la celda)
Range(posicion).Select
End If
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox2_Click()
Dim Evita_copia As Boolean
Evita_copia = False
'Ocultamos el proceso, para que no se vean las operaciones
Application.ScreenUpdating = False
'Creamos la variable "posicion", que contendrá el rango actual donde estamos situados,
'es decir, si estamos en F16, la variable "posicion" contendrá esa celda
posicion = ActiveCell.Address
'Si el checkbox lo ponemos como true (ON), que haga lo siguiente
If CheckBox2.Value = True Then
'Seleccionamos el rango que queremos copiar
Range("B16:I16").Select
'Lo copiamos
Selection.Copy
'Seleccionamos el rango de destino de la copia
Range("B37:I37").Select
'Lo pegamos
ActiveSheet.Paste
'Desactivamos el área de selección de copia y pegado
Application.CutCopyMode = False
'Nos desplazamos a la celda de origen, es decir, allí donde
'estábamos inicialmente (por eso hemos guardado en "posicion", la celda)
Range(posicion).Select
'Si el checkbox está como false (OFF), que borre el contenido de B1 a B3
Else
Evita_copia = True
'Seleccionamos el rango que queremos borrar
Range("B37:I37").Select
'Borramos el contenido
Selection.ClearContents
'Nos desplazamos a la celda de origen, es decir, allí donde
'estábamos inicialmente (por eso hemos guardado en "posicion", la celda)
Range(posicion).Select
End If
'Mostramos el proceso
Application.ScreenUpdating = True
End Sub

Sub Worksheet_Change(ByVal Target As Range)
Dim Evita_copia As Boolean
Application.ScreenUpdating = False

'Miramos si el rango de B6 a I16, cambia, para llamar al evento Click del CheckBox1
'(esto no es mío, ya que lo he sacado después de escarbar un poco en la red):
If Not Intersect(Target, Range("B17:I17")) Is Nothing And Not Evita_copia And CheckBox1.Value = True Then
'Creamos la variable "posicion", que contendrá el rango actual donde estamos situados,
'es decir, si estamos en F16, la variable "posicion" contendrá esa celda
posicion = ActiveCell.Address
'Seleccionamos el rango que queremos copiar
Range("B17:I17").Select
'Lo copiamos
Selection.Copy
'Seleccionamos el rango de destino de la copia
Range("B38:I38").Select
'Lo pegamos
ActiveSheet.Paste
'Nos desplazamos a la celda de origen, es decir, allí donde
'estábamos inicialmente (por eso hemos guardado en "posicion", la celda)
Range(posicion).Select
'Desactivamos el área de selección de copia y pegado
Application.CutCopyMode = False
End If


If Not Intersect(Target, Range("B16:I16")) Is Nothing And Not Evita_copia And CheckBox2.Value = True Then
'Creamos la variable "posicion", que contendrá el rango actual donde estamos situados,
'es decir, si estamos en F16, la variable "posicion" contendrá esa celda
posicion = ActiveCell.Address
'Seleccionamos el rango que queremos copiar
Range("B16:I16").Select
'Lo copiamos
Selection.Copy
'Seleccionamos el rango de destino de la copia
Range("B37:I37").Select
'Lo pegamos
ActiveSheet.Paste
'Nos desplazamos a la celda de origen, es decir, allí donde
'estábamos inicialmente (por eso hemos guardado en "posicion", la celda)
Range(posicion).Select
'Desactivamos el área de selección de copia y pegado
Application.CutCopyMode = False
End If
'Mostramos el proceso
Application.ScreenUpdating = True

End Sub