Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » ¿ACOPLAR? MACROSo FUNCIONES

Excel - ¿ACOPLAR? MACROSo FUNCIONES

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil
Val: 179
Ha aumentado su posición en 2 puestos en Excel (en relación al último mes)
Gráfica de Excel

¿ACOPLAR? MACROSo FUNCIONES

Publicado por Jose (80 intervenciones) el 26/06/2019 21:44:57
Buenas tardes,
Antes de nada deseo agradecer vuestra paciencia y la ayuda que me aportays para finalizar este trabajo.
Estoy trabajando en un libro de excel que tiene 3 hojas.
Con vuestra ayuda he conseguido maquetar parte del trabajo que pretendo finalizar.
Ahorra estoy estancado porque a las macros abajo indicados:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub CheckBox1()
' Habitaciones

    If Range("A1").Value = "Falso" Then
       ActiveSheet.Rows("15:33").EntireRow.Hidden = True
    Else
       ActiveSheet.Rows("15:33").EntireRow.Hidden = False
    End If
End Sub
 
Sub CheckBox7()
' Servcio extra de comedor

    If Range("A2").Value = "Falso" Then
       ActiveSheet.Rows("33:41").EntireRow.Hidden = True
    Else
       ActiveSheet.Rows("33:41").EntireRow.Hidden = False
    End If
End Sub
 
Sub CheckBox9()
' Alquiler sala

    If Range("A3").Value = "Falso" Then
       ActiveSheet.Rows("42:45").EntireRow.Hidden = True
    Else
       ActiveSheet.Rows("42:45").EntireRow.Hidden = False
    End If
End Sub
Sub CheckBox12()
' Coffee break

    If Range("A4").Value = "Falso" Then
       ActiveSheet.Rows("46:51").EntireRow.Hidden = True
    Else
       ActiveSheet.Rows("46:51").EntireRow.Hidden = False
    End If
End Sub
Sub Macro2()
Dim Fila As Long, H1 As Worksheet, H2 As Worksheet
'--

Application.ScreenUpdating = False 'Evita el parpadeo

Set H1 = Sheets("Sheet1")
Set H2 = Sheets("Sheet2")
'--

Fila = H2.Range("A" & Rows.Count).End(xlUp).Row + 1
H2.Range("A" & Fila) = H1.Range("K7")
H2.Range("F" & Fila) = H1.Range("B2")
H2.Range("G" & Fila) = H1.Range("I4")
H2.Range("H" & Fila) = H1.Range("K5")
H2.Range("I" & Fila) = H1.Range("C7")
H2.Range("A4:K" & Fila).Sort Key1:=H2.Columns("A")
H1.Range("B2:K2").ClearContents
H1.Range("C7:I7").ClearContents
H1.Range("K7").ClearContents
H1.Range("B2").Select
End Sub

No consigo añadir la siguiente función:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Option Explicit
 
Public Anterior As String
 
'Private Sub Worksheet_Change(ByVal Target As Range)

'    MsgBox "Worksheet_Change"

'End Sub

 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Celda(4) As String, Datos(4) As String, _
        Texto(4) As String, a As Byte
 
 
    Celda(1) = "$B$2:$K$2"
    Celda(2) = "$C$7:$I$7"
    Celda(3) = "$K$7"
    Celda(4) = "$C$8:$H$8"
 
    Datos(1) = "B2"
    Datos(2) = "CT"
    Datos(3) = "K7"
    Datos(4) = "CO"
 
    Texto(1) = "Pon aquí en nombre (celdas combinadas)"
    Texto(2) = "Indica la edad"
    Texto(3) = "Indica sexo"
    Texto(4) = "celdas combinadas"
 
    For a = 1 To 4
        If Anterior = Celda(a) Then
           If Range(Datos(a)) = "" Then
              Range(Datos(a)) = Texto(a)
           End If
        End If
 
        If Target.Address = Celda(a) Then
           If Range(Datos(a)) = Texto(a) Then
              Application.EnableEvents = False: Range(Datos(a)) = ""
              Application.EnableEvents = True
           End If
        End If
    Next
    Anterior = Target.Address
End Sub

Adjunto el trabajo para corregir el error que cometo.

Perdonar mi torpeza.

Gracias.
Saludos,
Jose
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

¿ACOPLAR? MACROSo FUNCIONES

Publicado por Antoni Masana (2478 intervenciones) el 27/06/2019 08:43:59
Ayer por falta de tiempo me falto explicar como funciona la macro.

La macro Worksheet_SelectionChange se ejecuta cada vez que se cambia de celda, para ser más exactos al entrar en una nueva celda y al parámetro Target nos da datos de la celda.

La referencia de las celdas que da Target son Absolutas, es por es que todas tienen el símbolo $ (DÓLAR)

Si la celda es combinada da la referencia de la primera y última celda.

En la tabla CELDA tenemos los valores de las cuatro posiciones que hemos de tratar.
En la tabla DATOS tenemos el nombre de la celda done ponemos el texto o validamos contenido.
En la tabla TEXTO los textos de fondo.
La variable ANTERIOR es para saber la ultima celda en la que estábamos.

Como funciona la macro.

El FOR hace dos cosas al mismo tiempo:

1º Si la celda anterior es una de las que tengo controladas y esta vacía vuelve a poner el texto de fondo.

2.º Si la celda en las que entro es una de las que tengo controladas y el contenido es el texto de fondo la dejo vacía para que pueda escribir. El Application.EnableEvents es para evitar que se ejecuten eventos como el que se esta ejecutando al modificar la celda y evitar que entre en bucle.

Por ultimo guarda la celda en la que acaba de entrar.

El truco de la hoja

Como abras comprobado en el libro que te envié solo se puede saltar a las cuatro celdas especificas. Esto se hace bloqueando las demás celdas.

Seleccionas toda la hoja pulsando en el recuadro done coinciden la numeración de las filas y las columnas, es decir el recuadro que hay encima del 1 y a la izquierda de la A.

Seleccionas la ventana de Fuentes y vas a la pestaña Proteger y marcas Bloqueada y Oculta y das aceptar
Ahora selecciona las celdas en las que el usuario puede escribir.

Seleccionas la ventana de Fuentes y vas a la pestaña Proteger y desmarcas Bloqueada y Oculta y das aceptar.
Ahora solo queda ir a la pestaña Revisar, grupo Cambios y proteger la hoja, (Mejor con contraseña)
Y Ya esta.

FALLOS

A demás de las correcciones que marco debería cambiar el color y la alineación para hacerlo diferente cuando hay el texto de fondo (gris claro, centrado) y cuando escribe (negro, alineado a la izquierda)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Explicit
 
Public Anterior As String
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Celda(4) As String, Datos(4) As String, _
        Texto(4) As String, a As Byte
 
    Celda(1) = "$B$2:$K$2"
    Celda(2) = "$C$7:$I$7"
    Celda(3) = "$K$7"
    Celda(4) = "$C$8:$H$8"
 
    Datos(1) = "B2"
    Datos(2) = "CT"
    Datos(3) = "K7"
    Datos(4) = "CO"
 
    Texto(1) = "Pon aquí en nombre (celdas combinadas)"
    Texto(2) = "Indica la edad"
    Texto(3) = "Indica sexo"
    Texto(4) = "celdas combinadas"
 
    For a = 1 To 4
        If Anterior = Celda(a) Then
           If Range(Datos(a)) = "" Then
               Application.EnableEvents = False: Range(Datos(a)) = Texto(a)
               Application.EnableEvents = True
           End If
        End If
 
        If Target.Address = Celda(a) Then
           If Range(Datos(a)) = Texto(a) Then
              Application.EnableEvents = False: Range(Datos(a)) = ""
              Application.EnableEvents = True
           End If
        End If
    Next
    Anterior = Target.Address
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 179
Ha aumentado su posición en 2 puestos en Excel (en relación al último mes)
Gráfica de Excel

¿ACOPLAR? MACROSo FUNCIONES

Publicado por Jose (80 intervenciones) el 27/06/2019 22:06:20
Gracias Antoni,
Lo estoy probando y de momento me defiendo con dificultad pero voy avanzando.
Al final he entendido donde debo de grabar la macro Worksheet_SelectionChange
Te he hecho caso y he bloquedo las celdas de la hoja1 para las celdas que no hay que tocar, pero he visto que en cuanto grabo los datos las celdas en causa (las que indican lo que hay que hacer) no son visibles con el texto indicado.
De hecho son visibles solo cuando las selecionas o algo asi, sera mejor que despues de grabar los datos sean visibles todos los "avisos"
Esto es lo que he conseguido hacer:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Option Explicit
 
Public Anterior As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim Celda(4) As String, Datos(4) As String, _
        Texto(4) As String, a As Byte
 
 
 
    Celda(1) = "$B$2:$K$2"
 
    Celda(2) = "$C$7:$I$7"
 
    Celda(3) = "$K$7"
 
    Celda(4) = "$C$8:$H$8"
 
 
 
    Datos(1) = "B2"
 
    Datos(2) = "C7"
 
    Datos(3) = "K7"
 
    Datos(4) = "C8"
 
 
 
    Texto(1) = "Escoje una opción"
 
    Texto(2) = "Indica el nombre del GRUPO"
 
    Texto(3) = "Rsva. Nº"
 
    Texto(4) = "Persona de contacto"
 
 
 
    For a = 1 To 4
 
        If Anterior = Celda(a) Then
 
           If Range(Datos(a)) = "" Then
 
               Application.EnableEvents = False: Range(Datos(a)) = Texto(a)
 
               Application.EnableEvents = True
 
           End If
 
        End If
 
 
 
        If Target.Address = Celda(a) Then
 
           If Range(Datos(a)) = Texto(a) Then
 
              Application.EnableEvents = False: Range(Datos(a)) = ""
 
              Application.EnableEvents = True
 
           End If
 
        End If
 
    Next
 
    Anterior = Target.Address
 
End Sub

Gracias de antemano por tu ayuda.
Adjunto el documento por si te ayuda en entenderme.
Te deseo una buena tarde/noche,
Saludos,
Jose
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar