Saltar al contenido

Si el nombre del libro no es el correcto, No habilitar los formularios


Recommended Posts

publicado

Hola! amigos del foro quisiera solicitarles el apoyo con lo siguiente, estoy intentando crear un código que revise al abrir un libro verifiqué si el nombre del libro es el asignado lo valide, en caso que el nombre no corresponda no permita habilitar los formularios que se encuentran en cada una de las hojas, los cuales se activan mediante un botón.

Inicialmente he creado el evento open para validar el nombre del libro, pero aún no logro como definir que si este nombre es diferente no permita habilitar los formularios con el clic del botón.

 

Agradezco la colaboración que me puedan brindar.

Private Sub Workbook_Open()

Dim nombre As String

Dim archivo As String



archivo = "C:\carpeta\libro1.xlsm"

nombre = ActiveWorkbook.FullName



If nombre = archivo Then



MsgBox "Hola Se ha revisado el nombre del libro"



Else

MsgBox "No tendra acceso a los formularios"


End If

End Sub

 

Libro2.xlsm

publicado

El siguiente codigo valida si el nombre coincide con tu variable y si no coincide, inhabilta los botones(controles) de cada una de tus hojas.

P. D. Debes tener el mismo nombre del boton(CommandButton1) en cada una de tus hojas para que funcione.

Private Sub Workbook_Open()
Dim I As Integer
Dim nombre As String

Dim archivo As String



archivo = "C:\carpeta\libro1.xlsm"

nombre = ActiveWorkbook.FullName


If nombre = archivo Then


    For I = 1 To Sheets.Count
        
        Sheets(I).CommandButton1.Enabled = True
    
    Next I
    
MsgBox "Hola Se ha revisado el nombre del libro"


Else

    For I = 1 To Sheets.Count
        
        Sheets(I).CommandButton1.Enabled = False
    
    Next I

MsgBox "No tendra acceso a los formularios"


End If

End Sub

 

publicado

@Enigma25 gracias por el aporte, a manera de consulta, si quisiera crear una excepción sobre una hoja sería posible? Por ejemplo que la hoja 4 si habilite el  botón(CommandButton1).

publicado

@Enigma25 he surgido un problema que pasé por alto, el código que me aportaste funciona bastante bien el detalle es que si las hojas se encuentran nombradas o se cambia su nombre salta el error:

 

 Sheets(I).CommandButton1.Enabled = True

Como puedo definir los diferentes nombres de las hojas (BD, RV, Datos,Informe, Extras) por poner ejemplos. Por ultimo sería posible si el  botón(CommandButton1), cambia su nombre: CommandButton5, CommandButton6, se pueda incluir?

 

Quedo atento a tus comentarios.

publicado

@Enigma25 lo he resuelto de la siguiente manera:

 

If nombre = archivo Then


    For I = 1 To Worksheets.Count
        
        Worksheets("BD").CommandButton1.Enabled = True
        Worksheets("BD").CommandButton2.Enabled = True
        Worksheets("RV").CommandButton1.Enabled = True
        Worksheets("Datos").CommandButton1.Enabled = True
        
    
    Next I

 

publicado

Precisamente te sugerí el Bucle For Next para que recorras cada una de las hojas sin usar WorkSheets("Nombre_Hoja") con su respectivo nombre el cual si tendrás problemas cuando cambies el nombre de la hoja (Pestaña) y lo verás en el futuro.

Si estás haciendo referencia a cada hoja con su respectivo nombre, ya no necesitarías el bucle For Next.

Por otro lado, he corrido el código sugerido y he cambiado el nombre por cada prueba y no me arroja el error que comentas. 

Intenta cambiando el bucle For Next por lo siguiente:

 For I = 1 To Sheets.Count
        
       Worksheets(I).CommandButton1.Enabled = True
    
 Next I

y/o 

 For I = 1 To Sheets.Count
        
      Worksheets(I).CommandButton1.Enabled = False
    
 Next I

 

publicado

hola, a ambos !

Hace 17 horas, Jose BN dijo:

lo he resuelto de la siguiente manera:

algunas sugerencias (necesitas ser menos ambiguo con las instrucciones a vba):

1) las comparaciones textuales son sensibles a las (may/min)usculas
o fuerzas la comparacion con funciones
if lcase(<variable1>) = "texto en minusculas"
if ucase(<variable>) = "TEXTO EN MAYUSCULAS"
o pones al inicio del modulo: option compare text

2) referencias a objetos (como las hojas) tiene varias alternativas
- nombre en las etiquetas (entre comillas) no importa si lo indicas en (may/min)usculas, no hay dos hojas con el mismo nombre
- el "codename" (lo que ves en el explorador de proyectos) como Hoja1, Hoja2, etc.
- el indice (posicion) de las hojas en el libro ( worksheets(1), worksheets(2), etc. )

3) hojas en bucles ?
arrays:

for each hoja in worksheets(array("hoja1, "hoja2", "hoja3", ...)

indices:

for n = 1 to worksheets.count
  worksheets(n). ... ... ...

codenames: (referirlos tambien en una matriz/array)

Worksheets refiere solo a hojas de calculo
Sheets refiere a todo tipo de hojas en el libro (graficos y otros tipos)

4) objetos incrustados que pudieran tener nombres diferentes ?
- cuantos commandbuttons hay en cada hoja ?
- si es un solo commandbutton (sin importar el nombre) puedes usar esto en el evento '_open' del libro

Private Sub Workbook_Open()
  Dim OnOff As Boolean, hoja As Worksheet
  OnOff = LCase(ThisWorkbook.FullName) = "c:\carpeta\libro1.xlsm"
  For Each hoja In Worksheets: hoja.OLEObjects(1).Enabled = OnOff: Next
  Worksheets(4).OLEObjects(1).Enabled = True
End Sub

 

publicado
Hace 6 horas, Héctor Miguel dijo:

4) objetos incrustados que pudieran tener nombres diferentes ?
- cuantos commandbuttons hay en cada hoja ?
- si es un solo commandbutton (sin importar el nombre) puedes usar esto en el evento '_open' del libro

Hola! @Héctor Miguelgracias por tus acertados comentarios, tomaré nota, en respuesta al ultimo punto te comento que los objetos incrustados pueden tener nombres diferentes, pueden haber de 1 a 3 en cada hoja.

Aprovechando que "salto la liebre" con tu solución se podría adaptar a estos escenarios o bien  ya lo expuesto es funcional.

 

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29

    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • Exelente solución mil gracias 
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.