Jump to content

LeandroA

Members
  • Content Count

    178
  • Joined

  • Last visited

  • Days Won

    4

Everything posted by LeandroA

  1. Hola te dejo esta herramienta que hice hace un tiempo te puede ayudar un poco mas para formar el xml
  2. me refiero al cuadro amarillo de la imagen que se muestra al entrar el foco en una celda, no es lo mismo que el comentario que es cuando pasamos el puntero sobre la celda, este tiene una descripción de lo que uno quiera agregar a esa celda, como se hace?
  3. hola como primer medida creo que tendrias que hacer esto en la pc que ejecute el excel https://helpx.adobe.com/la/acrobat/using/enable-pdf-thumbnail-preview-windows-explorer.html luego para extraer la imagen desde macros es un poco complicado a la hora de si se s ejecuta en un windows de 32 o 64 bits creo que la forma mas fácil y segura es si se programa en un ejecutable o una dll que exporte la miniatura a un archivo de imagen o directamente al portapapeles y luego con las macros la pegas o la lees, si te interesa alguna de estas opciones veo si puedo hacer algo, solo confirmame para no hacerlo al pepe.
  4. Hola ya hace un par de años no puedo entrar al foro, porque al parecer utiliza un protocolo no admitido el error devuelto ERR_SSL_VERSION_OR_CIPHER_MISMATCH aclaro que estoy bajo un próxi el cual no tengo acceso.
  5. hola la verdad no se porque sera, no se si te lo hace con todos los archivos o con el que estas actualmente, quizas estes con un archivo de una version vieja de excel? igualmente aprovecho para hacer publicidad de mi editor con este seguramente no vas a tener ese problema Saludos y me cuentas si te sirvió.
  6. hola no estoy seguro si hacerlo con un lector no saltara dos celda, pero bien por mi parte la solucion que me viene a la cabeza es utilizar un userform con un cuadro de texto, quizas el lector arroje algún caracter especial que ayude a identificarlo de si es un tipeo o una lectora. todo esto lo puede hacer en el evento TextBox1_KeyDown en caso que no arroje ningún carácter especial, si entre el primer caracter y el ultimo caracter existe mas de un cierto tiempo es porque se ha tipeado el código a mano. cuando KeyCode = 13 (o 10 según el lector) debe volcar el contenido del textbox a la ultima celda. espero haber echo entender y espero sepa como llevar a cabo dicha solución propuesta.
  7. hola podes hacerlo asi Public Sub CambiarForma() Dim c As Comment For Each c In ActiveSheet.Comments c.Shape.AutoShapeType = 10 Next End Sub
  8. Muy bueno no sabia que los comentarios se podían tratar como shapes
  9. hola este tema ya estaba resuelto o sacan la información de un mismo lugar 'Para mostrar un UserForm sin barra de titulo necesitamos cuatro funciones API: Private Const GWL_STYLE = -16 Private Const WS_CAPTION = &HC00000 #If VBA7 Then #If Win64 Then Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr #Else Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr #End If Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr #Else Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long #End If Private Sub UserForm_Initialize() 'Este código realiza el procedimiento de ocultar la barra de título, haciendo uso de las API Dim lngWindow, lFrmHdl lFrmHdl = FindWindowA(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl)
  10. hola Josera por las dudas descomprimiste todo del archivo Libro1 + mapa.html?
  11. @bigpetroman Hola, si es cierto que cuelga el programa en x64 pero al quitar ese tercer parámetro deja de funcionar el hook, por eso no te tira mas el error, pero tampoco cambia el texto de los botones, el problema esta en la función ObjectFromPtr (ya corregido) fijate que el autor puso en win64 CopyMemory obj, lPtr, 4 y CopyMemory obj, 0&, 4 siendo que lPtr en win64 en longptr por lo tanto tienen un largo de 8 y no 4 #If Win64 Then Private Property Get ObjectFromPtr(ByVal lPtr As LongPtr) As Object Dim obj As Object CopyMemory obj, lPtr, 8 Set ObjectFromPtr = obj CopyMemory obj, 0&, 8 End Property #Else Private Property Get ObjectFromPtr(ByVal lPtr As Long) As Object Dim obj As Object CopyMemory obj, lPtr, 4 Set ObjectFromPtr = obj CopyMemory obj, 0&, 4 End Property #End If CustomMsgbox (1).xlsm
  12. hola como lo haces desde el evento exit debes cancelar la salida del foco si no se cumple la condición pero también tienes que tener en cuenta que el usuario no quiera cerrar el formulario por lo tanto debes verificar si este esta visible. Private Sub cboNitProveedor_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Me.Visible = False Then Exit Sub If txtProveedor = "" Then If MsgBox("El proveedor no existe en la base de datos" & vbNewLine & _ "Agreguelo a la lista con el botón " & Chr(34) & "Agregar Proveedor" & Chr(34), vbInformation + vbRetryCancel, Titulo) = vbRetry Then 'cboNitProveedor.SetFocus cboNitProveedor.SelStart = 0 cboNitProveedor.SelLength = Len(cboNitProveedor) Cancel = True End If End If End Sub
  13. hola si efectivamente el servicio no da mas de 200 registros por lo tanto las consultas no deberian ser mayor a las de un dia, para hacer la consulta de un mes usted deberia hacer un bucle desde el primer dia del mes hasta el ultimo y llamara a la funcion con las mismas fechas y su codigo. esta es la función que esta en el userform póngala en un modulo publico y como tarea cree una macro que realize el bucle antes mencionado. Public Sub Consultar(ByVal FechaInicial As String, ByVal FechaFinal As String, ByVal Codigo As String) Dim xmlhttp, HtmlDoc, Objs Dim i As Long, j As Long, sText As String Dim Mat(1 To 200, 1 To 18) If Len(Codigo) < 9 Then MsgBox "La partida debe tener 9 dígitos como mínimo" Exit Sub End If If Not IsDate(FechaInicial) Or Not IsDate(FechaFinal) Then MsgBox "Fecha invalida" Exit Sub End If FechaInicial = Replace(Format(FechaInicial, "dd/mm/yyyy"), "/", "%2F") FechaFinal = Replace(Format(FechaFinal, "dd/mm/yyyy"), "/", "%2F") Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP") Set HtmlDoc = CreateObject("htmlfile_FullWindowEmbed") xmlhttp.Open "POST", "http://www.aduanet.gob.pe/cl-ad-itestdesp/Sgboletin", False xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" xmlhttp.send "orden=part&FecInicial=" & FechaInicial & "&FecFinal=" & FechaFinal & "&codigo=" & Codigo HtmlDoc.body.innerHTML = StrConv(xmlhttp.responseBody, vbUnicode) Set xmlhttp = Nothing If HtmlDoc.getElementsByTagName("table").Length = 0 Then MsgBox "Sin Resultados" Exit Sub End If Set Objs = HtmlDoc.getElementsByTagName("table")(0).Rows For i = 2 To Objs.Length For j = 0 To 17 Mat(i - 1, j + 1) = Objs(i - 1).Cells(j).innerText Next Next Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(Objs.Length, 18) = Mat sText = HtmlDoc.getElementsByTagName("font")(0).innerText 'Descripcion General MsgBox "Se han añadido " & Objs.Length - 1 & " resultados de" & vbCrLf & vbCrLf & sText Erase Mat Set Objs = Nothing Set HtmlDoc = Nothing Unload Me End Sub Saludos.
  14. Hola te adjunto lo que pedís, pero seguramente tendrás que hacer algún pequeño ajuste mas a tu comodidad. Saludos. Consulta.xlsm
  15. hola proba con estas declaraciones. Option Explicit 'Para mostrar un UserForm sin barra de titulo necesitamos cuatro funciones API: Private Const GWL_STYLE = -16 Private Const WS_CAPTION = &HC00000 #If VBA7 Then #If Win64 Then Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr #Else Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr #End If Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr #Else Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long #End If Private Sub UserForm_Initialize() 'Este código realiza el procedimiento de ocultar la barra de título, haciendo uso de las API Dim lngWindow, lFrmHdl lFrmHdl = FindWindowA(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl) '----------------------------------------------------------------------------------------- 'Cargamos el formulario y establecemos un timer para que se cierre automáticamente Dim Contador, Maximo, Intervalo As Double ' As Integer Dim Inicio As Double Dim X Intervalo = 0.001 Maximo = 300 Me.Show For Contador = 1 To Maximo Inicio = Timer Do Until Timer - Inicio > Intervalo X = DoEvents() Loop Me.lbl_Bar.Width = Contador Me.lbl_Percent.Caption = "Cargando " & Format(Contador / Maximo, "Percent") Next Contador frm_login.Show End End Sub
  16. Hola proba esto, parece andar bien, pone el código en un modulo, seguramente se pueden quitar algunas lineas que están de mas. Option Explicit #If VBA7 Then Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr) #Else Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) #End If Private Const VK_SNAPSHOT As Long = &H2C Private Const VK_LMENU As Long = &HA4 Private Const KEYEVENTF_KEYUP As Long = &H2 Public Sub PrintActiveFrom() DoEvents keybd_event VK_LMENU, 0, 0, 0 keybd_event VK_SNAPSHOT, 0, 0, 0 keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0 keybd_event VK_LMENU, 0, KEYEVENTF_KEYUP, 0 DoEvents With Workbooks.Add().ActiveSheet .PasteSpecial .Range("A1").Select With .PageSetup .PrintArea = "" .Orientation = xlLandscape .PrintTitleRows = "" .PrintTitleColumns = "" .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.75) .RightMargin = Application.InchesToPoints(0.75) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) .PrintHeadings = False .PrintGridlines = False .CenterHorizontally = True .CenterVertically = True .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 End With .PrintOut Copies:=1 End With ActiveWorkbook.Close False End Sub
  17. LeandroA

    timeout

    Hola con la propiedad SetTimeouts podes darle el tiempo que quieras. S Sub web() Set httpRequest = CreateObject("WinHttp.winHttpRequest.5.1") With httpRequest .Option(4) = &H100 .Open "GET", "http:......." .SetTimeouts 5000, 5000, 5000, 5000 .send If .Status = 200 Then MsgBox .responseBody End If End With End Sub
  18. Hola que tipo de archivos son? Si son imagenes no es dificil, pero seguramente seran otros archivos, ese codigo esta en vb.net por lo que no te va a funcionar. Se que se puede hacer con una libreria externa, pero tendras que portarla junto con el documento en el pc que quieras ejecutarlo, igualmente en estos dias no voy a poder ayudarte pero si te interesa me avisas y cuando vuelva te ayudo.
  19. bien, sin ver el archivo no se puede ayudar.
  20. hola habria que ver el archivo o ver el código de fuente y is es posible en que parte especifica te da el error
  21. Perdon chicos hoy repase todas las lineas y tenia un error donde selecionaba una celda y activaba la hoja eso hacia que perdiera el foco gracias por todo.
  22. hola @Héctor Miguel no estoy seguro que esto igual en todos los Drive de impresión, en mi caso el userform no recupera el foco, se activa la ventana de impresión, se cierra y vaya a saber uno donde va a parar el foco, la cosa es que cuando presiono enter en el textbox imprime pero luego debo hacer click nuevamente en el textbox o en el userform para que este tome el foco nuevamente y poder ingresar otro dato, En resumen es escribir en el textbox presionar Enter se imprime y repetir el proceso si tener que usar el mouse para devolverle el foco. @Gerson Pineda setfocus es valido dentro del entorno del userform, pero como es el userform el que pierde el foco no se como activarlo, tras colmo esto lo tengo en mi trabajo y no puedo hacer muchas pruebas y en casa no tengo impresora, pregunto porque quizás alguno ya se había topado con este problema y lo tenia resuelto. Gracias.
  23. Hola Tengo un UserForm en el cual solo tengo un TextBox y un CommandButton con la propiedad Default = True Private Sub CommandButton1_Click() Cells(1, 1) = Now Cells(1, 2) = TextBox1.Text Hoja1.PrintOut End Sub mi pregunta es como le retorno el foco (ventana Activa) al formulario (exactamente al TextBox) una vez que imprimió? hice algunas pruebas pero sin resultados positivos y mucho mas no quiero probar para no gastar Hojas. con OneNote es distinto ya que después de cerrar la ventana de este si retorna el foco al userform pero me interesa con una impresora real. Saludos.
  24. Hola 502 hojas es una locura, me colgo la pc casi no pude ver casi nada, pero con lo poco que vi déjame sugerirte algunas cosas, no crees una hoja por cliente o producto no recuerdo bien que era, no es necesario vos deberias almacenar toda esa información en una hoja luego si queres generar una hoja para imprimir rellenas los datos en una hoja maestra, en caso de que en cada hojas llenes datos exclusivos para ese cliente deberías trabajar como si fuera una base de datos es decir en otra hoja vas guardando todos los datos con el id del cliente luego para recuperar los datos te basas en ese id. Saludos.
×
×
  • Create New...

Important Information

Privacy Policy