Jump to content

AlexanderS

Moderators
  • Content Count

    1,287
  • Joined

  • Last visited

  • Days Won

    52

Everything posted by AlexanderS

  1. Hola @hernanmrx, prueba el adjunto y comentas. Saludos. Ejemplo.xlsx
  2. Hola @Manuel TR, por la forma en que copias los archivos descomprimidos a una carpeta windows debe preguntar si se debe sobrescribir un archivo que tiene el mismo nombre, esta es una desventaja de la linea que hay que utilizar para copiar un archivo de una carpeta comprimida a otro ubicación. Mi solución es copiar temporalmente esos archivos a una carpeta "Temporal" y después utilizar el comando "Scripting.FileSystemObject" el cual si tiene una propiedad para indicar si un archivo puede ser sobrescrito. Sub Desc_Zip() Dim FSO As Object, obj As Object, objScripting As Object Dim objCarpeta Set FSO = CreateObject("Scripting.FileSystemObject") Set obj = CreateObject("Shell.Application") iArchivo = Application.GetOpenFilename(filefilter:="Archivos ZIP (*.zip), *.zip", MultiSelect:=True) If IsArray(iArchivo) = False Then Exit Sub Ruta = Application.ActiveWorkbook.Path & "\" Nombre_Carpeta = Ruta & "ARCHIVOS EXTRAIDOS " & Replace(Date, "/", "_") & " " & Format(Now, "hh_mm_ss") & "\" Set objScripting = CreateObject("Scripting.FileSystemObject") Set objCarpeta = objScripting.CreateFolder(Nombre_Carpeta) For i = LBound(iArchivo) To UBound(iArchivo) For Each file In obj.Namespace(iArchivo(i)).items obj.Namespace(Environ$("tmp")).CopyHere obj.Namespace(iArchivo(i)).items.Item(CStr(file)) FSO.copyFile Environ$("tmp") & "\" & file, Nombre_Carpeta, True FSO.DeleteFile Environ$("tmp") & "\" & file Next Next i End Sub Prueba y comentas. Saludos.
  3. Hola @juanmanuel85 acabo de subir al foro un aporte que tal vez se ajuste a lo que necesitas. Saludos.
  4. Hola @Gerson Pineda, lo que pasa es que este archivo lo tenia para uso personal con algunas columnas mas y se me olvido corregir el rango cuando las elimine. Subo el archivo con la corrección, gracias por avisar. Saludos.
  5. Hola, esto es solo para darle un poco mas de visibilidad al aporte, también se aceptan sugerencias. Saludos a todos.
  6. Version 1.0.1

    96 downloads

    Que tal, les comparto este archivo el cual utilizo para enviar correos de Outlook desde la comodidad de Excel. Esto es de utilidad si como en mi caso necesitas enviar un mismo correo a varias personas pero con diferentes archivos adjuntos. Sin mas espero que el aporte sea de utilidad. Saludos.
  7. @Leopoldo Blancas como te comente la forma de crear un listview en tiempo de ejecución seria esta: Private Sub Crea_Control() Dim Xlist As Object With Me Set Xlist = .Controls.Add("MSComctlLib.ListViewCtrl.2", "ListView") With Xlist .Height = 300 .Width = 300 .ColumnHeaders.Add 1, "@", "Ejemplo1", 200 .ColumnHeaders.Add 2, "#", "Ejemplo2", 50 .ColumnHeaders.Add 3, "$", "Ejemplo3", 148 .Gridlines = True .View = 3 End With End With End Sub Saludos.
  8. Hola, perdón no había podido responder @Pirtrafilla, no debería haber ningún problema ya que lo que cambias es el nombre que se refiere al objeto pero de igual forma lo que utilizamos es el nombre de la hoja. @Leopoldo Blancas, tengo que probar pero la cosa va por aquí: Set ctrl = NewForm.Designer.Controls.Add("MSComctlLib.ListViewCtrl.2") Y con respecto a lo que comenta @digitalboy un complemento es una buena idea mas si lo implementas con un "Ribbon" personalizado. Saludos.
  9. Hola, prueba ahora he modificado el código no deberia importar como se llamen los modulos o las hojas. Comentas. Saludos. Actualizar VBA.xlsm
  10. Que tal @Pirtrafilla, realize una modificación al código para que puedas actualizar varias hojas o mudulos al mismo tiempo, ahora debes tener un txt por cada hoja o modulo que quieras actualizar, cada una con su correspondiente versión colocadas en la ruta que especificaras en el código dentro de "Workbook_Open". En el ejemplo adjunto tengo dos modulos "Code", "Code2" y una hoja "Hoja2" que quiero actualizar entonces debo tener los archivos así: Tema aparte, tambien es posible crear nuevos modulos, botones e incluso formularios, pero esto tomaria mas tiempo del que puedo permitirme para modificar el código, como referencia puedo dejarte este aporte que utiliza la creación de objetos en tiempo de ejecución. Saludos. Actualizar VBA.xlsm
  11. En esta linea TextBox11.Text = TextBox7.Text * 0.03 Si dejas el Textbox11 vacio estarias multiplicando un espacio vacio de texto * 0.03, lo cual logicamente dara un error. Lo correcto puede ser: If Not TextBox11 = "" Then TextBox11 = CDbl(TextBox7) * 0.03 Lo mismo aqui: TextBox12.Text = TextBox7.Text - TextBox11.Text Y en esto: TextBox12.Value = FormatNumber(TextBox12.Value, 2) Si lo dejas vacio, como le das un formato numerico a un valor vacio? Espero haberme explicado. Saludos
  12. Bueno @Pirtrafilla ya que gracias a @Leopoldo Blancas lograste hacer funcionar el codigo, solo queda que lo pruebes para ver si se adapta a tus necesidades. Recuerda dar el tema como solucionado si fuera el caso. Cualquier duda tanto yo como el resto del foro estamos dispuestos a echarte una mano. Saludos a ambos.
  13. @Pirtrafilla, es posible que compartas tu archivo? Este código lo desarrolle para mi trabajo ya que tenia una situación similar a la tuya, siempre me ha funcionado sin problemas.
  14. Hola @Leopoldo Blancas y @Pirtrafilla Voy a tratar de explicar los pasos correctamente. Lo mas importante es que deben tener activa la opción "Confiar en el acceso al modelo de objetos de proyectos de VBA" desde la configuración de Macros del centro de confianza, ya que escribiremos código en tiempo de ejecución, esto se debe realizar solo 1 vez en las PC's que tendrán el archivo. . Ahora en el modulo donde queremos tener el código actualizable se debe colocar un número el cual representara la versión del archivo. En el archivo txt también deberá tener un número de versión. El código de actualización deberá estar ligado a la apertura del libro, ya que este realiza una comprobación de los números que mencione antes, lee el numero de la versión en el modulo y el del txt si el del txt es diferente al del modulo, extraerá todo lo que esta escrito en el txt y reemplazara todo en el modulo indicado. *La actualización se realiza con la apertura del libro por lo que para realizar pruebas deben con el libro excel cerrado modificar el txt cambiando el numero de versión, al abrir el Excel los números entre el modulo y el txt serán diferentes y en ese momento se ejecuta la actualización. El botón azul solo ejecuta la macro "Prueba" que es un simple mensaje. Espero haberme dado a entender. Saludos.
  15. Hola @Pirtrafilla, hace algunos años realice un aporte que te puede ayudar, se trata de una macro que actualiza el código de otros archivos ubicados en una red local. Dado que se han realizado cambios al foro desde que subi el aporte no se si todavía funciona el adjunto o entenderás la explicación, ahorita voy de salida pero si te interesa mañana lo puedo revisar. Saludos.
  16. @eayvl si la suma la debes realizar sobre esa columna "P.BULTO" por que no abrias de incluirla? Si analizas el código que tenias esta limitado a la cantidad de rangos y ciclos for que tenga, el código que te pase puede tener tantas columnas como quieras y los bloques pueden ser del tamaño que quieras tambien, con la unica condición de que la columna "P.BULTO" exista. Entonces deberias revisar que es mas facil o eficiente, modificar el código a mano para añadir los bloques con sus condiciones o solo colocar una palabra en la columna que quieres sumar(tambien podrias cambiar la palabra sobre el código)? Saludos.
  17. Hola @merlyn333 y @Gerson Pineda, aunque el tema esta resuelto quiero dejar mi aporte, talvez sea de utilidad. Documento = Split(Split(Range("A2"), "=")(2), ",")(0) Saludos
  18. @eayvl Prueba ahora Saludos. Sub Genera_txt() Dim rg As Range Dim linea$, txt$, ruta$, formato$ formato = "dd/mm/yyyy" ruta = ThisWorkbook.Path & "\" For Each rw In Range("A2", [A1].End(xlDown)) For Each cl In Range("A1", [A1].End(xlToRight)) Set rg = Cells(rw.Row, cl.Column) If IsDate(rg) Then linea = linea & "|" & Format(rg, formato) Else linea = linea & "|" & rg If cl.Column > 3 Then If cl = "P.BULTO" Then If (CDbl(rg.Offset(0, -1))) + CDbl(rg) = 0 Then linea = "" If cl = "P.BULTO" And Len(linea) > 3 Then txt = txt & Right(linea, Len(linea) - 1) & vbCrLf: linea = "" End If Next archivo = Format(Now, "dd mmm yyyy hh mm ss AMPM ") & rw.Row & ".txt" Open ruta & archivo For Output As #1: Print #1, txt: Close #1 txt = "" Next End Sub
  19. Hola @eayvl, prueba este código Genera_txt Sub Genera_txt() Dim rg As Range Dim linea$, txt$, ruta$ ruta = ThisWorkbook.Path & "\" For Each rw In Range("A2", [A1].End(xlDown)) For Each cl In Range("A1", [A1].End(xlToRight)) Set rg = Cells(rw.Row, cl.Column) linea = linea & "|" & rg If cl.Column > 3 Then If cl = "P.BULTO" And (Val(rg.Offset(0, -1))) + Val(rg) = 0 Then linea = "" If cl = "P.BULTO" And Len(linea) > 3 Then txt = txt & Right(linea, Len(linea) - 1) & vbCrLf: linea = "" End If Next archivo = Format(Now, "dd mmm yyyy hh mm ss AMPM ") & rw.Row & ".txt" Open ruta & archivo For Output As #1: Print #1, txt: Close #1 txt = "" Next End Sub Como veras modifique el código que tenias y le añadí la condición que querías. Comentas. Saludos. genera txt.xlsm
  20. Hola @eayvl al descargar el archivo me indica que esta dañado, ¿lo puedes volver a subir? Saludos.
  21. @FloP vamos por partes, si pulsas cancelar en "Application.GetSaveAsFilename" el valor de la variable "myFile" pasa a ser "False" pero si seleccionas "Guardar" el valor de "myFile" pasa a ser la ruta que introdujiste como nombre del nuevo PDF, por lo tanto "myFile" nunca podra ser igual a "True" y como no es igual a "True" no ejecutara las lineas dentro de ese "IF" Lo correcto seria que las lineas quedaran asi: myFile = Application.GetSaveAsFilename(InitialFileName:=strName, FileFilter:="PDF (*.pdf), *.pdf") If myFile = False Then GoTo Line1 If Dir(strName & ".pdf") = strName & ".pdf" Then Ans = MsgBox(strName & ".pdf ya existe." & vbCrLf & "¿Desea reemplazarlo?", vbQuestion + vbYesNo, "Confirmar Guardar como") If Ans = vbYes Then GoTo Line0 If Ans = vbNo Then GoTo Line1 End If Line0: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strName, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False MsgBox "Archivo guardado en:" & vbCrLf & vbCrLf & strPath, vbInformation Line1: ActiveSheet.Rows.EntireRow.Hidden = False ActiveSheet.Range("A1").Select Application.ScreenUpdating = True Debes tener cuidado donde colocas los "IF" y los "End IF", como puede ver en el código adjunto, se abrira el cuadro para que elijas donde guardar el archivo, en el primer if "If myFile = False Then GoTo Line1" comprobamos si se preciono sobre cancelar ya que la variable "myFile" esta como "False", de cumplirse esta condición nos llevara a la linea1, de no cumplirse pasara sobre el segundo if y continuara con el resto del código. Saludos
  22. Hola @FloP, no puedo descargar tu archivo, pero básicamente seria algo así: myFile = Application.GetSaveAsFilename(InitialFileName:=strName, FileFilter:="PDF (*.pdf), *.pdf") If myFile = False Then ' Acción si se preciona el botón Cancelar Else ' Acción si se Preciona Aceptar End If No debes utilizar los signos "<" o ">", si no el igual "=" Saludos.
  23. @Visor, me gustaria que fueras mas claro sobre que es lo que no te funciono ya que leyendo tus comentarios el código que te comparti hace lo que quieres: 1. Puedes ver el resultado sobre el textbox según vas ingresando las letras. 2. Solo permite ingresar las letras "abcd". 3. Solo permite ingresar 4 digitos en el textbox. 4.Graba en la celda el resultado del textbox. Por cierto y si es por eso que no te funciono debes dejar los 4 ceros dentro del textbox estos se reemplazan por la letra cuando la precionas. Saludos.
  24. Hola @Visor y demas compañeros, puedes probar con este código: completar con ceros segun letra-s que se ingresa.xlsm Public a As Boolean, b As Boolean, c As Boolean, d As Boolean Private Sub TextBox1_Change(): Me.TextBox1 = Left(Me.TextBox1, 4): End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Select Case KeyCode Case 65: a = True Case 66: b = True Case 67: c = True Case 68: d = True End Select If KeyCode = 65 Or KeyCode = 66 Or KeyCode = 67 Or KeyCode = 68 Then If d = True Then Me.TextBox1 = "000d" & Right(Me.TextBox1, 0) If c = True Then Me.TextBox1 = "00c" & Right(Me.TextBox1, 1) If b = True Then Me.TextBox1 = "0b" & Right(Me.TextBox1, 2) If a = True Then Me.TextBox1 = "a" & Right(Me.TextBox1, 3) End If End Sub Private Sub UserForm_Initialize() Me.TextBox1 = "0000" End Sub Private Sub CommandButton1_Click() Hoja1.Cells(10, 14) = TextBox1 End Sub Comentas. Saludos a todos.
×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png