Hola,
Hay alguna macro posible que haga que sólo se pueda seleccionar una celda a la vez? De manera que el usuario no pueda seleccionar más de una celda a la vez

 

Gracias

Hola!

Tendrías que poner esto en el código de cada una de tus hojas.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Target.Cells(1).Select
End Sub

 

Hace 9 horas, DiegoPC dijo:

Hola!

Tendrías que poner esto en el código de cada una de tus hojas.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Target.Cells(1).Select
End Sub

 

O una sola vez en ThisWorkbook:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Target(1).Select
End Sub

 

Hola,

gracias, funciona bien, pero me gustaría sólo en la primera hoja, pero me deshabilita otras funcionalidades de la hoja, como botones de formulario. Cómo lo pondrías en este código?

Option Explicit

Public ValorAnterior As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)



If Target.Column >= 2 And Target.Row >= 8 Then

    ValorAnterior = Target.Value
    
End If

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim HojaLog As Worksheet
    Dim rangolog As Range
    Dim NuevaFila As Integer
    Dim ColInicio As Integer
    Dim FechaInicio As Date
    Dim FechaCambio As Date
    Dim FechaLunes As Date
    Dim RangoCal_1 As Range
    Dim Despl As Integer
    Dim selecto As Range
    
   
    'Si la celda modificada no está entre las filas 8 a 17, sale
    If (Not (Target.Row >= 8 And Target.Row <= 17) And Not (Target.Row >= 21 And Target.Row <= 30)) Or Target.Column > 373 Or Target.Column < 2 Then Exit Sub
    
    'Calcula fecha de incio del calendario en base a los datos de las celdas A1 y A2
    FechaInicio = CLng(CDate("01/" & LeaveTracker.Cells(1, 1).Value & "/" & LeaveTracker.Cells(2, 1).Value))
    
    'Construir fecha seleccinada
    FechaCambio = DateSerial(CInt(LeaveTracker.Cells(2, 1).Value), _
        CInt(LeaveTracker.Cells(1, 1).Value + LeaveTracker.Cells(3, 1).Value - 1), _
        CInt(LeaveTracker.Cells(5, Target.Column).Value))
    
    'Calcular desplazamiento del rango en base a meses de menos de 31 dias
    Despl = (LeaveTracker.Cells(3, 1) - 1) * 31 - (CLng(FechaCambio) - CLng(FechaInicio) - Day(FechaCambio)) - 1
    
    'Determinar columna del lunes para la semana definida
    FechaLunes = FechaCambio - Weekday(FechaCambio, vbSunday) + 2 '+ Despl
    
    'Columna seleccionada sera FechaLunes - FechaInicio
    ColInicio = CInt(FechaLunes - FechaInicio) + 2 + Despl
 
    Set RangoCal_1 = Union(LeaveTracker.Range(Cells(8, ColInicio), Cells(17, ColInicio + 4)), LeaveTracker.Range(Cells(21, ColInicio), Cells(30, ColInicio + 4)))
    
    Call Colorear(ColInicio)
    
   
If Target.Column >= 2 And Target.Row >= 8 Then

 

    Set HojaLog = ThisWorkbook.Sheets("LogDetails")
    Set rangolog = HojaLog.Range("A1").CurrentRegion
    NuevaFila = rangolog.Rows.Count + 1

    With HojaLog
        .Cells(NuevaFila, 1).Value = Date
        .Cells(NuevaFila, 2).Value = Time
        .Cells(NuevaFila, 3).Value = Target.Address
        .Cells(NuevaFila, 4).Value = ValorAnterior
        .Cells(NuevaFila, 5).Value = Target.Value
        .Cells(NuevaFila, 6).Value = Environ("Username")
        .Cells(NuevaFila, 7).Value = Right(Target.Address, 2)
        .Cells(NuevaFila, 8).Value = Mid(Target.Address, 2, 2)
        .Cells(NuevaFila, 9).Value = "=VLOOKUP(RC[-2],userranges,2,FALSE)"
        .Cells(NuevaFila, 10).Value = "=IF(RC[-2]=RC[-4],"""",""INCORRECT"")"
        .Cells(NuevaFila, 11).Value = "=VLOOKUP(RC[-3],REF,2,FALSE)"
        .Cells(NuevaFila, 12).Value = "=VLOOKUP(RC[-4],REF,3,FALSE)"
        .Cells(NuevaFila, 13).Value = "=VLOOKUP(RC[-5],REF,4,FALSE)"
        .Cells(NuevaFila, 14).Value = "=VLOOKUP(RC[-6],REF,5,FALSE)"
        .Cells(NuevaFila, 15).Value = "=IF(RC[-10]=""v"",1,-1)"
        .Cells(NuevaFila, 16).Value = "=VLOOKUP(RC[-8],REFF,6,FALSE)"
        .Cells(NuevaFila, 17).Value = "=(1/5)*RC[-2]"
        .Cells(NuevaFila, 18).Value = "=VLOOKUP(RC[-9],inf,3,FALSE)"
        .Cells(NuevaFila, 19).Value = "=RC[-4]+R[-1]C[-4]"
        
    End With
   
    End If
    
    End Sub