Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic para Aplicaciones » 2 procedimientos dentro de la misma hoja

Visual Basic para Aplicaciones - 2 procedimientos dentro de la misma hoja

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:

2 procedimientos dentro de la misma hoja

Publicado por Gomito (1 intervención) el 17/02/2019 15:34:26
hola, ojalá me pueda ayudar, tengo poco conocimiento en vba, pero me defiendo. Mi problema es que tengo 2 procedimientos que quiero ejecutar e una hoja de calculo. Son del tipo Worksheet_SelectionChange(ByVal Target As Range).
Los he tratado de juntar, pero no lo he logrado. el primero es un cuadro combinado autorelleno y el segundo es un llamado a un calendario. Solo me funciona el primero, el segundo lo he probado en forma independiente y funciona bien.

primer código:

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2018/9/21

    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr
    Dim X As Range
    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("TempCombo")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            If .ListFillRange = "" Then
                xArr = Split(xStr, ",")
                Me.TempCombo.List = xArr
            End If
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.TempCombo.DropDown
    End If
    If Not Intersect(Target, Range("$C$")) Is Nothing Then
        Load frmCalendario
        frmCalendario.Show
    End If
End Sub
 
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 
    Select Case KeyCode
        Case 9
            Application.ActiveCell.Offset(0, 1).Activate
 
        Case 13
            Application.ActiveCell.Offset(1, 0).Activate
            'Buscar_bd

 
    End Select
End Sub

Segundo código:

1
2
3
4
5
6
7
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Lanzar control de calendario al elegir la celda B3
If Target.Address = "$C$8" Then
    Load frmCalendario
    frmCalendario.Show
End If
End Sub
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: 1.134
Oro
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

2 procedimientos dentro de la misma hoja

Publicado por Antoni Masana (498 intervenciones) el 18/02/2019 07:00:46
Un par de cosas:

- En el segundo código el comentario, que no es tal, por B3 y en la condición C8, ¿A cual he de creer?
- El ON ERROR RESUME NEXT sobra. Si da error es porque vo validas bien los datos.

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '--- Update by Extendoffice: 2018/9/21

    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr
    Dim X As Range
 
    ' --- Lanzar control de calendario al elegir la celda B3

    If Target.Address = "$C$8" Then
        Load frmCalendario
        frmCalendario.Show
        Exit Sub
    End If
 
    Set xWs = Application.ActiveSheet
'''   On Error Resume Next

    Set xCombox = xWs.OLEObjects("TempCombo")
 
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
 
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            If .ListFillRange = "" Then
                xArr = Split(xStr, ",")
                Me.TempCombo.List = xArr
            End If
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.TempCombo.DropDown
    End If
 
    If Not Intersect(Target, Range("$C$")) Is Nothing Then
        Load frmCalendario
        frmCalendario.Show
    End If
End Sub
 
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case 9:   Application.ActiveCell.Offset(0, 1).Activate
        Case 13:  Application.ActiveCell.Offset(1, 0).Activate 'Buscar_bd

    End Select
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