Jump to content

Mauricio_ODN

Members
  • Posts

    996
  • Joined

  • Last visited

  • Days Won

    61

Everything posted by Mauricio_ODN

  1. Hola @Will_2105 Te dejo una posible solución. Nos comentas --> Private Sub CommandButton1_Click() Workbooks.Open "C:\Users\lema7015\Downloads\Book2.xlsm" 'la ruta de tu archivo ''ActiveWindow.WindowState = xlMinimized ''Application.WindowState = xlMinimized Windows("Book2.xlsm").WindowState = xlMinimized 'sustituyes Book2.xlsm por el nombre de tu archivo UserForm1.CommandButton1.SetFocus End Sub <-- PD. El Foro no me dejo adjuntar los archivos.
  2. Hola @OTOMEVIANEY2 Tendrías que modificar o cancelar el siguiente evento acorde a lo que necesites: Private Sub Worksheet_SelectionChange(ByVal Target As Range) Nos comentas, Saludos.
  3. Hola @lsmaniahotmail.com Una opción seria así: Private Sub UserForm_Activate() Dim oRG As Range 'Utilizo este codigo para llenar el listBox Set oRG = Sheets("CUENTAS").ListObjects("Tab_Cta").Range Me.ListCtas.RowSource = "=CUENTAS!" & oRG.Address Me.ListCtas.ColumnCount = 6 'para no mostrar los Txt del formulario frmCtas.Height = 250 ' cuando hago click en el boton editar , si muestra todo End Sub Nos comentas, Saludos.
  4. Hola de nuevo @SALAVERRINO Acabo de enviarlo, nos comentas. Saludos.
  5. Hola @SALAVERRINO Te comparto una posible solución. Nos comentas, Saludos. Sub ElegirAccion() Dim i As Long Dim intInicial As Integer Dim intFinal As Integer Dim intConsecutivo As Integer Dim srtTitulo As String Dim Ruta As String Dim nombre As String Dim pass As String, hoja As String Dim oPj As Double Application.DisplayAlerts = False Application.ScreenUpdating = False Sheets("BOLETA PDF").Activate hoja = "BOLETA PDF" nombre = ThisWorkbook.Sheets("PLANILLA").Range("BC8").Value srtTitulo = "PRUEBITA" intConsecutivo = ThisWorkbook.Sheets("BOLETA PDF").Range("CONSECUTIVO").Value intInicial = Sheets("PLANILLA").Range("AZ8") intFinal = Sheets("BOLETA PDF").Range("M3") ''linea añadida UserForm1.Show If intFinal < intInicial Or intFinal > intConsecutivo Then MsgBox "Valida el ID final.", vbExclamation, srtTitulo Else Sheets("BOLETA PDF").Select Ruta = ActiveWorkbook.Path & "\BOLETAS" For i = intInicial To intFinal ''lineas añadidas oPj = Round(i / intFinal, 2) * 100 Application.StatusBar = "Procesando el archivo... " & i & " de " & intFinal & " - " & oPj & "% Completed" UserForm1.Label1.Caption = "Procesando el archivo... " & i & " de " & intFinal & " - " & oPj & "% Completed" Application.Wait (Now + TimeValue("0:00:01")) ThisWorkbook.Sheets("BOLETA PDF").Range("L4").Value = i ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & Sheets("BOLETA PDF").Range("B6") & ".pdf", _ Quality:=xlQualityMinimum, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False Next i End If Application.StatusBar = False Unload UserForm1 MsgBox "Boletas Generadas...... ", , "AVISO" Sheets("MENU").Activate Range("B8").Select intInicial = Sheets("PLANILLA").Range("AZ8") Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub -->> Habrá que crear el userform1 (adjunto el que use, no puedo compartirte el archivo por su peso) UserForm1.frm UserForm1.frx
  6. Hola @paikerr Tal vez el archivo te pueda ayudar un poco. Nos comentas, Saludos. FrezeeP_1.1.xlsm
  7. Hola @kai7as Al hacer la prueba no me presento problema. Sub prueba() Dim entero As Long Dim str As String entero = 212341234 str = CStr(entero) Range("K1").Value = str Debug.Print str End Sub Solo omití el "QR." de esta linea -> QR.Range("k1").Value = str Nos comentas, Saludos.
  8. Hola @Ricky9825 si va hacer de manera manual, podría sugerirte inmovilizar los paneles o aplicar división(split) en la ventana. Si es automático, se puede con una macro por evento, para eso revisa el archivo. Nos comentas Buscar1.1.xlsm
  9. Hola @Puche Estas en lo correcto, esa es la linea que debes cambiar. Como no se que tamaño de papel tengas habilitado en la impresora que usas, te recomiendo que, grabes una macro, selecciones el tipo de papel que se ajusta al tamaño del userform, detengas la macro y busques la linea "PaperSize", ese seria la que tendrías que sustituir en la linea que me preguntas. Sigo atento, saludos.
  10. Hola de nuevo @Maria_80 Estaba tratando de orientarte, para que de alguna forma, entendieras que hace tu código para que tu misma pudieras solucionarlo. Lamento si esto te incomodo o molesto. No estaba dando una solución en especifico, solo trataba que aprendieras. Me disculpo por el inconveniente. Te dejo una posible solución. ejemplo_copypaste 1.1.xlsm
  11. Hola de nuevo @Maria_80 Creo que no has revisado particularmente lo que hace tu código, cuando solo tienes un registro a copiar, te va a copiar todas las filas de tu hoja (1,048,576). Caso contrario cuando tienes dos o mas registros, intenta agregar otro registro y hacer una prueba. Nos comentas. Saludos.
  12. Hola @Maria_80 Acorde a tu código: Range(Range("A2"), Range("A2").End(xlDown)).Select Range(Selection, Selection.Offset(, 44)).Select ' para que abarque 45 columnas (siempre es una menos) Selection.Copy Estas copiando todas filas de la hoja Sheets("TBIS"), cuando tratas de pegar en la primera fila sin datos de la otra hoja, por eso te marca error. Nos comentas.
  13. Hola @Puche Te mando nuevamente el archivo la linea de código que debieras cambiar es esta: --> .PaperSize = xlPaper11x17 Lo anterior acorde a los tamaños de papel que tengas instalados. Nos comentas, Saludos. PD Si quieres seguir con tu proyecto original puedes cambiar el zoom del Userform BUENO1.2.xlsm
  14. Hola @Puche Te dejo otra alternativa, Nos comentas. BUENO1.1.xlsm
  15. También te puede servir esta otra forma Input 2.xlsm
  16. Hola @renato13 Haber prueba con el archivo. Nos comentas Saludos. Input 1.xlsm
  17. Hola @Puche Algo que te puede ayudar en lo que llegan más respuestas, seria ajustar el zoom: Private Sub bt_imprimir_Click() With FrmListBoxProductos .Zoom = 63 .PrintForm .Zoom = 100 End With End Sub Nos comentas, Saludos.
  18. Hola @lucas_545 Particularmente prefiero abrir los libros desde el código de vba (para evitar estos inconvenientes), pero siguiendo la linea de lo que comentas, posiblemente esa consulta te pueda ayudar: https://stackoverflow.com/questions/31927222/circumvent-hyperlink-security-warning Nos comentas, Saludos.
  19. Hola @renato13 tienes detalle en la linea: If NombreArchivo = "" Then NombreArchivo = ActiveSheet.Name Si realizas debug al código, te darás cuenta que cuando le das cancelar al inputbox, registra el valor como "" , por consecuencia asume que la hoja a enviar es la hoja activa. Una alternativa sería: If NombreArchivo = "" Then Exit sub, pero todo depende de lo que necesites que haga el código después cancelar. Nos comentas. Saludos.
  20. Te dejo el archivo que al final abrí en Excel 2019. Nos comentas, Saludos. Mis contraseÃ_±as1.2.xlsm
  21. Hola @zelarra821, creo que ya no entendí, la consulta fue: En Excel 2010 En Excel 2019 Cabe señalar que para Excel 2019, habilite la configuración para macros, controles Activex y archivos provenientes de internet.
  22. Hola @zelarra821 Haber si así se soluciona. Nos comentas, Saludos. Mis contraseñas1.1.xlsm
  23. Buen día a todos. Les agradezco a los que leyeron la publicación, después de una entretenida búsqueda si con la solución: Sub Soft_Test() Dim cObj As Object Dim Programa As Object Dim Proceso As Object Set cObj = GetObject("winmgmts://.") Set Proceso = cObj.ExecQuery("SELECT * FROM " & _ "Win32_Process WHERE Name = 'SoftToken.exe'") For Each Programa In Proceso On Error Resume Next If Err.Number = 0 Then AppActivate Programa '<- esta linea es la realiza lo que necesitaba Call Programa.Terminate On Error GoTo 0 Next Set Proceso = Nothing Set cObj = Nothing End Sub Por lo que no tengo inconveniente en cerrar el tema. Saludos.
  24. Hola de nuevo @Janlui Te dejo una "maqueta" que te puede ayudar Funciona en 3 pasos: 1.- Click en el icono Navegador (dejas que cargue completa la pagina) 2.- Click en el icono URL 3.- Click en el icono Paste Espero sea de ayuda, nos comentas Sigo atento a tus comentarios, Salud os. G_Maps 1.1.1_.xlsb
×
×
  • Create New...

Important Information

Privacy Policy