Saltar al contenido

AlexanderS

Moderadores
  • Contador de contenido

    1216
  • Unido

  • Última visita

  • Days Won

    46

Sobre AlexanderS

  • Rango
    Riddle

Información de perfil

  • Sexo Hombre
  • Localización: Costa Rica

Configuraciones

  • Campo que utilizas como separador de argumentos ,

Visitantes recientes del perfil

3035 visitas de perfil
  1. Hola @AlexanderS,

    Estoy haciendo una aplicación y utilice tu Procedimiento que pongo más abajo, lo que resulta es que en un libro nuevo si genera el Botón y el código en la hoja y en mi proyecto solo genera el Botón y el código en la hoja NO.  Sabras algo de incompatibilidad. Los libros están habilitados para macros.

    Private Sub Insert_Boton()
    Dim hoja As Object
    Dim m As Double
    Dim bt As Range
    Dim cTexto As String
    On Error Resume Next
    Set bt = Application.InputBox(Prompt:="Selecciona donde se creara el botón para llamar el formulario", Title:="By Riddle", Type:=8)
    
    Set hoja = ThisWorkbook.VBProject.VBComponents(bt.Parent.Name)
        With Sheets(bt.Parent.Name).OLEObjects.Add(classtype:="Forms.CommandButton.1", _
             Top:=bt.Top, Left:=bt.Left, _
             Height:=bt.Height * 2, Width:=bt.Width * 2)
             .Object.Caption = "Formulario"
             .Name = "boton" & "Leopoldo"
         End With
       
         With hoja.CodeModule
         cTexto = "Private Sub boton" & "Leopoldo" & "_Click()" & vbNewLine
         cTexto = cTexto & "    MsgBox """ & " Hola """ & vbNewLine
         cTexto = cTexto & "End Sub"
         .InsertLines .CountOfLines + 1, cTexto
         End With
     
    End Sub

    Saludos.

    NOTA: Lo que me queda hacer es pasar mis modulos  a un nuevo libro y veo si resulta, gracias.

    1. Leopoldo Blancas

      Leopoldo Blancas

      OK, Creo que el archivo estaba ya "Dañado", Copie módulos a un nuevo libro y ya quedo.

      Gracias y saludos.

    2. Leopoldo Blancas

      Leopoldo Blancas

      OK, Creo que el archivo estaba ya "Dañado", Copie módulos a un nuevo libro y ya quedo.

      Gracias y saludos.

  2. Ya estaba apunto de reponderte eso mismo. Saludos.
  3. Hola @chilaquil, revisa el código que te dejo, debes tener activa la referencia "Microsoft ActiveX Data Objects 6.1 Library", esto para que funcione el código. La Base de Datos debe estar en la misma carpeta que el archivo excel. Public Sub Exportar_Access() Set cn = CreateObject("ADODB.Connection") dbPath = Application.ActiveWorkbook.Path & "\Base de datos11.accdb" dbWb = Application.ActiveWorkbook.FullName dbWs = Application.ActiveSheet.Name scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath dsh = "[" & Application.ActiveSheet.Name & "$]" cn.Open scn ssql = "DELETE FROM uno": cn.Execute ssql ssql = "INSERT INTO uno([Reg_Patr], [Num_Afil], [Tip_movs], [Fec_Inic], [Fec_Fin], [Fol_Inc]) " ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh cn.Execute ssql End Sub Comentas. Saludos
  4. AlexanderS

    CREAR MIS PROPIAS FECHAS

    Hola @paikerr, no veo necesario usar macros para esto. Si seleccionas la celda donde esta la fecha -> click derecho -> Formato de Celdas -> Personalizada, y colocas por ejemplo en el cuadro "tipo" lo siguiente : [$-040C]dddd mmmm yyy Crearas un formato de fecha personalizado donde [$-040C] indica el idioma Frances y dddd mmmm yyy el día mes y año en formato largo. [$-0410] Italiano [$-040C] Frances [$-0409] Ingles (U.S.) Otro Ejemplo: Comentas, saludos.
  5. AlexanderS

    separar texto en diferentes casillas

    Hola, parecido a la de Leopoldo, igualmente seleccionando el rango de celdas antes. Sub separar() Dim tx As Variant, celda As Range For Each celda In Selection tx = Split(celda, " ") Cells(celda.Row, celda.Column + 1).Resize(1, UBound(tx) + 1) = tx Next End Sub Saludos.
  6. AlexanderS

    Función contar sangría VBA

    Hola @joselopezitot tal como lo indica Héctor, excel no tiene forma de detectar un cambio en un formato, pero podemos valernos de algunos trucos como en tu caso donde insertas las sangrías con los botones de la cinta de opciones de excel. Este truco funciona utilizando el "Custom IU Editor", lo que haremos es interceptar el evento al presionar los botones para insertar o eliminar las sangrías para que ejecuten una macro y podamos re-calcular la hoja al presionar uno de estos 2 botones. Adjunto el ejemplo, me comentas. Saludos. Copia de SANGRÍA.xlsm
  7. AlexanderS

    Buscar registro en base access con un TextBox

    Hola @Pirtrafilla, te recomiendo leer un poco sobre lo básico de las consultas en SQL, puesto que si quieres trabajar con access utilizando ADO tendrás que utilizar SQL. Por el momento tomando en cuenta que no se la estructura de tu tabla "Tab_Procedimientos" , te dejo este código: Sub Prueba() Set rs = CreateObject("ADODB.Recordset") 'Indicamos en la consulta SQL, donde buscaremos en la columna "TuColumna" el valor del Textbox2 Sql = "Select * From Tab_Procedimientos where TuColumna =' & Texbox2 &'" 'Abrimos la conexión rs.Open Sql, Cnn, 3, 3, adCmdText 'Comprobamos si existe un registro If rs.EOF = False Then MsgBox "Existe" Else MsgBox "No Existe" End If 'cerramos la conexión rs.Close End Sub Ademas te dejo un pequeño ejemplo básico que había hecho para otro usuario con conexiones a Access, debes tener los dos archivos en la misma carpeta. Saludos. Ejemplo ADO.rar
  8. Hola @JSDJSD, modifica esta linea: Private Sub CommandButton3_Click() Dim Comentario As String For X = 0 To ListBox2.ListCount - 1 If ListBox2.Selected(X) Then Hoja2.Range("H" & ListBox2.List(X, 3)) = TextBox5.Value If TextBox4 <> "" Then Let Comentario = TextBox4.Value On Error Resume Next With Hoja2.Range("B" & ListBox2.List(X, 3)) .AddComment .Comment.Visible = False .Comment.Text Text:=Comentario End With End If End If Next CargarFacturas End Sub Y agrega estas nuevas: Private Sub ListBox2_Click() Dim comt As Range With Me.ListBox2 Set comt = Hoja2.Range("J:J").Find(.List(.ListIndex, 0), , , xlWhole) On Error Resume Next If Not comt Is Nothing Then Me.TextBox4 = Hoja2.Cells(comt.Row, "B").Comment.Text End With End Sub Comentas. Saludos.
  9. AlexanderS

    Cinta de Opciones Personalizada

    Hola @Haplox, se refiere a la galería de iconos integrados en Microsoft Office, los llamados imageMSO . Saludos.
  10. AlexanderS

    Cinta de Opciones Personalizada

    Hola @LAAM, en el siguiente link aparece una lista con sus respectivas imágenes. https://bert-toolkit.com/imagemso-list.html Saludos.
  11. AlexanderS

    Excel: macro para filtrar base por dos criterios

    Hola @Alex Razo, en un principio debería bastar con: Sub FiltrarEmpresa() criterio1 = [M2] criterio2 = [N2] With Range("A1:E1") If criterio1 = "" And criterio2 = "" Then .AutoFilter Else .AutoFilter Field:=3, Criteria1:=criterio1, Operator:=xlOr, Criteria2:=criterio2 End If Range("A1").Select End With End Sub Si no es lo que necesitas adjunta un archivo de ejemplo. Saludos.
  12. Hola @juanmafdez, puedes probar con este código suponiendo que la fecha esta en la celda A1. Sub separar() Dim FechayHora FechayHora = Range("A5") Range("B1:C1") = Array(CDate(Split(FechayHora, " ")(0)), Mid(FechayHora, InStr(FechayHora, " "))) End Sub Prueba y comentas. Saludos.
  13. Hola @hernanmrx, prueba el adjunto y comentas. Saludos. Ejemplo.xlsx
  14. AlexanderS

    Descomprimir masivamente y reemplazar duplicados

    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.
  15. AlexanderS

    Macro enviar email

    Hola @juanmanuel85 acabo de subir al foro un aporte que tal vez se ajuste a lo que necesitas. Saludos.
×

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.