Leaderboard

¡Ya está! Para mostrar una imagen que está en la hoja, hay que convertirla a jpg previamente. Abre el adjunto y pulsa sobre un código QR de la columna C. GENERADOR CODIGO QR.xlsm

perdón creo que mi gata camino sobre el teclado y corrió el código Contrastar Imagenes.xlsm

Hola Te dejo 2 alternativas, una con formula y otra con las poderosas TD Utiliza la que mas se adecue a tus intereses Saludos Busqueda con multiples criterios_GP.xlsx

Algo sencillo, te dejo una función que encripta/desencripta de forma alternativa. Con la hoja PNAC activada: 'En un módulo normal Function EncriptaDesencripta(Texto As String) As String For y = 1 To Len(Texto) Mid(Texto, y, 1) = Chr(255 - Asc(Mid(Texto, y, 1))) Next EncriptaDesencripta = Texto End Function Sub Ejemplo() 'Ejemplo de funcionamiento de la función Range("B2") = EncriptaDesencripta(Range("B2")) End Sub

Onkey, tiene un argumento opcional, que es llamar a un procedimiento, bueno ahi agregas el mensaje y listo Sub MostrarMensaje() If Application.OnKey Key:="{c}" Then "MiSub" End Sub Sub MiSub() VBA.MsgBox "Hola mundo" End Sub Saludos

@LeandroA, se están actualizando los permisos de los usuarios del foro y por alguna razón no estabas en el grupo adecuado. Te acabo de actualizar los permisos para que puedas utilizar el foro sin restricciones. Disculpa las molestias.

A ver si es esto lo que quieres: Sub opentxt() '.... '.... i = InStr(textData, "GROUP BY") textData = Left(textData, i - 1) & "WHERE C.[CODIGO REL] = '" & TextBox1 & "' " & Mid(textData, i) End Sub

Hola =MAYUSC(TEXTO(A1,"mmmm-aaaa")) Saludos

El método Find da error cuando no encuentra la celda con el valor buscado. Prueba así y si no te funciona, sube el archivo. DatoEncontrado = Usuarios.Rango.Find(What:=Me.TxtUsuario.Value, MatchCase:=False, lookat:=xlWhole).Address

Hola El comportamiento de las funciones utilizando formato de tabla estructurada, cambia respecto a las referencias Una forma sencilla de superarlo es usar referencias relativas de esas celdas Mira =SUMAR.SI.CONJUNTO(J$7:J7,C$7:C7,$C7) Saludos

¡Hola, @gogua! El tema de los rangos expandibles en tabla tienen un comportamiento "peculiar" cuando llegan al final de la misma. Entonces, una opción para trabajar con ellos es "jugar" con las referencias estructuradas. Tu fórmula, al tener un solo criterio, puede usarse con la función SUMAR.SI de la siguiente forma: =SUMAR.SI(C$7:[@CODIGO];[@CODIGO];J$7:[@[Ent./Sal.]]) ¡Pruébala y comentas! ¡Bendiciones!

Sub EncriptaDesencriptaPNAC() Application.ScreenUpdating = False x = 2 i = Timer Do Until Range("A" & x) = "" For y = 1 To 7 Cells(x, y) = EncriptaDesencripta(Cells(x, y)) Next If x Mod 5000 = 0 Then Application.StatusBar = "Procesando fila: " & x & " Tiempo total: " & Timer - i Application.ScreenUpdating = True DoEvents Application.ScreenUpdating = False End If x = x + 1 Loop End Sub Prueba así, en la barra de estado de Excel irá apareciendo el avance del proceso, el tiempo total para encriptar el archivo que has subido ha sido de 45 minutos más o menos. (2 GB de RAM a 1,8 Mz) En cuanto a la búsqueda en el formulario, es inviable desencriptar los datos cada vez que cargas el formulario. El único proceso de búsqueda es por valor exacto, por aproximación no es posible por la gran cantidad de información. Excel no esta pensado para tratar volúmenes de información como el que planteas. Si te interesa una búsqueda como la planteada, sube un archivo con unos centenares de registros y el formulario correcto, ya que en el último archivo el formulario y los datos no se corresponden.

Prueba y comenta. https://drive.google.com/file/d/1Kn4z4rR2FSanPlJZoNcDcctEqqxzpyCR/view?usp=sharing

'Ejemplo encriptar/desencriptar toda la hoja PNAC Sub EncriptaDesencriptaPNAC() Application.ScreenUpdating = False x = 2 Do Until Range("A" & x) = "" For y = 1 To 7 Cells(x, y) = EncriptaDesencripta(Cells(x, y)) Next x = x + 1 Loop End Sub 'Ejemplo para la fila 100 Sub EjemploFila100() Application.ScreenUpdating = False For y = 1 To 7 Cells(100, y) = EncriptaDesencripta(Cells(100, y)) Next End Sub Nota: En el archivo que has subido hay unas 7.000 filas con información y más de 1.000.000 en blanco.

No se puede, utiliza un userform con un label.

TextBox6 = Sheets("La hoja que quieras").Range("C10")

Abre el adjunto y pulsa en GENERAR CÓDIGOS QR y después en ELIMINAR CÓDIGOS QR. Mañana, si puedo, te mostraré como visualizar un código QR en un userform. GENERADOR CODIGO QR.xlsm

Antoni y Gerson magnificas respuestas he aprendido un resto, y mas a optimizar el código... Mil gracias, Dios los bendiga.

Hola Xoel, Es complicado ayudarte si no conocemos cómo tienes dispuestos los datos en las hojas. Entiendo que se trata de información confidencial por tanto te sugiero que clones tu libro de trabajo y elimines los datos privados pero mantengas su estructura. De otra forma no te podremos dar una solución concreta. Un saludo,

Hola Roxana Pero sin ver un archivo con tus "intentos" por tratar de resolverlo, no podremos hacer algún "intento" en darte una mejor orientación o ayuda Saludos

letras = Split(Columns(número).Address, "$")(2)

Enhorabuena por tu cambio de nombre Silvia, digo ...Laura. Vamos a celebrarlo: Saludos.

@pegones1 sin afán de sonar negativo al tema ni generar conflicto, tú te mereces el 100% de la nota.

Estimados Gracias por leer tema, pero les comento que lo he solucionado usando este codigo vba: Sub Copia_formato() 'Evitamos el parpadeo de la macro mientras trabaja Application.ScreenUpdating = False 'Creamos 1 variable donde almacenamos los nombre de las hojas del libro. Dim nom As String 'Creamos una variable para el valor de la cantida de hojas del libro. Dim Canthoja As Integer 'Contamos las hojas menos una. Canthoja = Sheets.Count - 1 'Creamos un ciclo desde 0 hasta la ultima hoja del libro menos una. For i = 0 To Canthoja 'Pasamos el nombre de la hoja activa a la variable nom. nom = ActiveSheet.Name 'Creamos una condición para movernos por las hojas. If ActiveSheet.Name <> Sheets(Sheets.Count).Name Then 'Seleccionamos la hoja3 y copiamos el rango A1:AH56. Worksheets("Certificado").Range("K1:AR56").Copy Worksheets(nom).Range("K1").Select Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False 'En la hoja activa pego. ActiveSheet.Paste 'Elimino las formulas y dejo los valores. Selection.Value = Selection.Value 'Borro las columnas desde la A a J. Range("A:J").Delete 'Creo un ciclo por each desde la primera fila hasta el rango A1:A57 For Each fila In Range("A1:A57") 'Verifico que las filas tengan la altula 12.75 y sino lo tienen les paso el valor. If fila = Empty Then fila.EntireRow.RowHeight = 12.75 Else fila.EntireRow.RowHeight = 12.75 'Salto a la siguiente fila. Next fila 'entonces pasamos a la siguiente hoja ActiveSheet.Next.Select End If 'Nos movemos a la proxima hoja. Next i Application.ScreenUpdating = True 'Volvemos la primera hoja del libro. Sheets("Certificado").Select End Sub[/CODE] Y usando la formula [CODE]EXTRAE(texto;posición_inicial;núm_de_caracteres)[/CODE] en cada una de las celdas donde necesitaba la información. Les dejo el código por si alguno les interesa o por si desean jugar un poquito con el para realizar algunas mejoras. Doy por cerrado este tema. Saludos. Gracias.