Jump to content

yordin

Members
  • Content Count

    175
  • Joined

  • Last visited

  • Days Won

    1

1 Follower

About yordin

  • Rank
    Advanced Member

Converted

  • Campos Array

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. yo uso oficce 2010 que es 14 creo, y uso esas versiones xq no todos los que usaran la base tienen el mismo oficce, y en cuanto a lo de ser poco practico, es que si le doy actualizar los datos siempre estan variando en diferentes columnas y prefiero evitar estos inconvenientes. en el link que me envías, indica que la cadena sql debe hacerse dependiendo el formato de cada columna? es que no entiendo muy bien soy relativamente nuevo en esto de vba..
  2. buenas tardes, escribo con la finalidad de solicitar apoyo en cuanto a mover datos de un excel a una tabla en Access. mi archivo de excel tiene los campos a exportar en los campos A2:AN8000 y los campos o nombres de columna estan en A1:AN1, en la hoja llamada Empleados requiero moverla a un Access llamado Datos.mdb el cual al abrir se debe colocar la clave "rrhh" en minúsculas, requiero que al pasar de excel al access sobrescriba lo que exista en el access tipo actualización de datos, que primero vacié la tabla Empleados del access y luego pegue los datos del Excel en Access. espero me puedan colaborar. dejo muestra de la base de Excel y del Access al abrir se debe colocar la clave "rrhh" en minúsculas https://mega.nz/#!AhcUxI5Y!zNt63rw9ExgyRTegkIpua9VRQHqHK9503cSw1-GIGfE
  3. El detalle estaba en que el visual hacia interferencia las minusculas y mayusculas en los datos del código quedo así: Private Sub cmdExportar_Click() If lblCriterio.Caption = "" Then MsgBox "Debe seleccionar un registro para exportar" Exit Sub End If If Me.cmbPlantilla.Text = "" Then MsgBox "Debe seleccionar un Documento para exportar" Exit Sub End If If UCase(Me.cmbPlantilla.Text) = UCase("Constancia de Trabajo") Then Call exportarconstancia ElseIf UCase(Me.cmbPlantilla.Text) = UCase("Medicinas / Estudios") Then Call exportarplantillamedicinas ElseIf UCase(Me.cmbPlantilla.Text) = UCase("Correo Egreso") Then Call exportarplantillacorreo ElseIf UCase(Me.cmbPlantilla.Text) = UCase("Anticipo de Prestaciones") Then Call exportarplantillaanticipos ElseIf UCase(Me.cmbPlantilla.Text) = UCase("Evaluacion Medica") Then Call exportarplantillaevamedica ElseIf UCase(Me.cmbPlantilla.Text) = UCase("Reporte 14-52") Then Call exportarplantilla1452 ElseIf UCase(Me.cmbPlantilla.Text) = UCase("Reporte 14-100") Then Call exportarplantilla14100 End If iniciagrid End Sub
  4. seria algo asi: Private Sub cmdExportar_Click() If cmbPlantilla = "Constancia de Trabajo" Then Call ExportarConstancia If cmbPlantilla = "Medicinas / Estudios" Then Call ExportarPlantillaMedicinas If cmbPlantilla = "Correo Egreso" Then Call ExportarPlantillaCorreo If cmbPlantilla = "Anticipo de Prestaciones" Then Call ExportarPlantillaAnticipos If cmbPlantilla = "Evaluacion Medica" Then Call ExportarPlantillaEvaMedica If cmbPlantilla = "Reporte 14-52" Then Call ExportarPlantilla1452 If cmbPlantilla = "Reporte 14-100" Then Call ExportarPlantilla14100 End Sub
  5. el detalle es que el combo esta mostrando los datos dependiendo los parámetros enviados desde las opciones del programa, si desde el programa se le solicita planillas muestre planillas, si es estados mostrara estados y así, cuando son estados no genera código al seleccionarlos sino opción a filtro en un grid, y cuando son planillas quería desde el botón imprimir según plantilla seleccionada en el combo.
  6. tengo en un form de visual 6.0 un combobox el cual tiene 4 items (planilla1, planilla2 planilla3 y planilla4) tengo un botón en el cual quiero agregar que al darle click al buton en el cual quiero que ejecute un código dependiendo de la planilla seleccionada en el bombo ejemplo di es la planilla 1 ejecute el código plani1, planilla dos y ejecute plani2 y así sucesivamente.
  7. Excelente amigo muchas gracias me ha servido....
  8. no me deja subirlos dejo link en mega del comprimido https://mega.nz/#!N0EAxCBB!-2kPLnOp6hF13G9nD1aHXoZVeVwQC5JRL-2Wyj1j5zA
  9. Disculpa veo que no me supe explicar. El excel es mi base de datos por defecto , es donde se baja la informacion por complementos desde el As400 de mi lugar de trabajo, pero tengo un programa que busca y emite diferentes documentos este alimentado de un Acces. quería pasar mediante una macro los datos del excel al Acces todas las columnas y filas existentes.
  10. buenos días, quería saber si alguien me podría indicar como mover una base de datos en excel de 30 columnas y 6500 filas a acces?? esto debido a que donde laboro esta base de datos de excel se actualiza cada 15 días y requiero moverla a acces para uso estadístico. esta macro debería cada vez sobre-escribir lo que exista en la tabla de acces llamada empleados. cabe destacar que el excel y el acces ambos estan en la siguiente ruta: Z:\Relación laboral\MILI\CONSTANCIAS\pruebas\ la clave del acces es " rrhh " gracias de antemano por su colaboración.
  11. Sub Import_TXT_Anchofijo() 'Definimos variables a utilizar Dim Filtro As String Dim nFichero As Integer Dim sCadena As Variant Dim i As Double nFichero = FreeFile 'indicamos que tipo de archivo que vamos a seleccionar (txt) Filtro = " TXT(*.TXT)," 'buscamos el archivo txt = Application.GetOpenFilename(Filtro) 'si existe fichero comenzamos la instrucción, de lo contrario el proceso no se 'inicia If txt <> Empty Then 'mediante un bucle do while recorremos todas las líneas de información del txt Open txt For Input As nFichero i = 0 Do While Not EOF(nFichero) Line Input #nFichero, datos i = i + 1 sCadena = datos 'definimos la longitud del ancho de cada información e indicamos en que columna se 'debe insertar 'la fila ya viene determinada con la longitud del fichero txt (i) que hemos 'definido al principio 'con la función Mid indicamos los campos a extraer y la con la función Trim 'eliminamos espacios en blanco 'que se nos puedan haber olvidado por error. With Sheets(1) .Cells(i, 1) = (Mid(sCadena, 1, 35)) .Cells(i, 2) = (Mid(sCadena, 36, 82)) .Cells(i, 3) = (Mid(sCadena, 118, 18)) .Cells(i, 4) = (Mid(sCadena, 136, 20)) .Cells(i, 5) = (Mid(sCadena, 156, 22)) .Cells(i, 6) = (Mid(sCadena, 176, 21)) End With Loop 'por último cerramos el proceso. Close nFichero End If End Sub
  12. Buenas tardes, escribo solicitando apoyo en cuanto a una macro que me pueda ayudar a importar un archivo TXT a un Excel y este se tiene que delimitar por una distancia fija que se selecciona con las flechas en el recuadro las distancias del archivo son 35, 105, 129, 150, 170 y 200 que al generarlo crea 7 columnas, incluyo un TXT muestra y un excel de como debería quedar, espero puedan colaborarme es que de esta importación luego tengo que replicarla unas 200 veces mas con históricos de años anteriores. QCNA 11.txt QCNA 11.xlsx
  13. buenos días amigos, escribo para ver si podrian ayudarme con una macro que realiza varias operaciones la he creado con la creadora de macros y añadiendo algunas opciones que he visto en internet, pero veo que tarda mucho en correr la macro completa. dejare la macro para ver si pueden ayudarme a agilizarla Private Sub CommandButton1_Click() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False 'VARIABLES Dim Celda As Range Dim PrimeraFila As Integer Dim PrimeraColumna As Integer Dim UltimaFila As Integer Dim UltimaColumna As Integer Dim shp As Object Dim tc As Integer Dim tr As Integer Dim Cuenta As Integer Dim ErrorHandler As String Dim misdatosArray(10) As String Dim i, x As Integer strFechador = Format(Now, " dd-mm-yy hh.mm.ss") 'GENERAR DATOS PC misdatosArray(0) = Application.UserName misdatosArray(1) = Environ("COMPUTERNAME") misdatosArray(2) = Environ("USERPROFILE") misdatosArray(3) = Environ("USERDOMAIN") x = 0 For i = 44 To 53 Cells(i, 3) = misdatosArray(x) x = x + 1 Next i 'IMPRIMIR Range("B7:I23").Select Selection.Copy Range("B26").Select ActiveSheet.Pictures.Paste.Select Range("B7:I43").Select Application.CutCopyMode = False Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With Application.PrintCommunication = True ActiveSheet.PageSetup.PrintArea = "$B$7:$I$43" Application.PrintCommunication = False With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.196850393700787) .RightMargin = Application.InchesToPoints(0.196850393700787) .TopMargin = Application.InchesToPoints(0.196850393700787) .BottomMargin = Application.InchesToPoints(0.196850393700787) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .CenterHorizontally = True .CenterVertically = False .Orientation = xlPortrait .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = True .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False 'CREAR MARCA DE AGUA ActiveSheet.Shapes.AddTextEffect(msoTextEffect13, "Espacio para el texto", _ "+mn-lt", 54, msoTrue, msoFalse, 535.864488189, 342.3041732283).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _ "SOLO" & Chr(13) & "PARA" & Chr(13) & "USO" & Chr(13) & "CONFIDENCIAL" With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 5). _ ParagraphFormat .FirstLineIndent = 0 .Alignment = msoAlignCenter End With With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 5).Font .Bold = msoTrue .Caps = msoNoCaps .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.RGB = RGB(255, 255, 255) .Fill.BackColor.RGB = RGB(255, 255, 255) .Fill.TwoColorGradient msoGradientHorizontal, 3 .Size = 96 .Line.Visible = msoTrue .Line.ForeColor.RGB = RGB(125, 125, 125) .Line.Transparency = 0 .Line.Weight = 0.83 .Line.DashStyle = msoLineSolid .Line.Style = msoLineSingle .Name = "+mn-lt" .Spacing = 0 End With With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(6, 5). _ ParagraphFormat .FirstLineIndent = 0 .Alignment = msoAlignCenter End With With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(6, 5).Font .Bold = msoTrue .Caps = msoNoCaps .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.RGB = RGB(255, 255, 255) .Fill.BackColor.RGB = RGB(255, 255, 255) .Fill.TwoColorGradient msoGradientHorizontal, 3 .Size = 96 .Line.Visible = msoTrue .Line.ForeColor.RGB = RGB(125, 125, 125) .Line.Transparency = 0 .Line.Weight = 0.83 .Line.DashStyle = msoLineSolid .Line.Style = msoLineSingle .Name = "+mn-lt" .Spacing = 0 End With With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(11, 4). _ ParagraphFormat .FirstLineIndent = 0 .Alignment = msoAlignCenter End With With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(11, 4).Font .Bold = msoTrue .Caps = msoNoCaps .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.RGB = RGB(255, 255, 255) .Fill.BackColor.RGB = RGB(255, 255, 255) .Fill.TwoColorGradient msoGradientHorizontal, 3 .Size = 96 .Line.Visible = msoTrue .Line.ForeColor.RGB = RGB(125, 125, 125) .Line.Transparency = 0 .Line.Weight = 0.83 .Line.DashStyle = msoLineSolid .Line.Style = msoLineSingle .Name = "+mn-lt" .Spacing = 0 End With With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(15, 12). _ ParagraphFormat .FirstLineIndent = 0 .Alignment = msoAlignCenter End With With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(15, 12).Font .Bold = msoTrue .Caps = msoNoCaps .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.RGB = RGB(255, 255, 255) .Fill.BackColor.RGB = RGB(255, 255, 255) .Fill.TwoColorGradient msoGradientHorizontal, 3 .Size = 96 .Line.Visible = msoTrue .Line.ForeColor.RGB = RGB(125, 125, 125) .Line.Transparency = 0 .Line.Weight = 0.83 .Line.DashStyle = msoLineSolid .Line.Style = msoLineSingle .Name = "+mn-lt" .Spacing = 0 End With Selection.ShapeRange.IncrementLeft -386.25 Selection.ShapeRange.IncrementTop -243.75 Selection.Copy Range("B26").Select ActiveSheet.Paste 'GUARDAR COMO PDF Application.PrintCommunication = True ActiveSheet.PageSetup.PrintArea = "$B$7:$I$60" Application.PrintCommunication = False ChDir "Z:\Publica RRHH\Documentos\utmp\" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "Z:\Publica RRHH\Documentos\utmp\" & Range("c10") & strFechador & ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False 'BORRAR IMAGENES Y MARCAs DE AGUA 'Recorre cada celda de la selección. For Each Celda In Range("a10:l53") PrimeraFila = Celda.Row PrimeraColumna = Celda.Column GoTo Jump Next Celda Jump: For Each Celda In Range("a10:l53") UltimaFila = Celda.Row UltimaColumna = Celda.Column Next Celda Cuenta = 0 'Recorre cada objeto de la hoja y valida su posición. For Each shp In ActiveSheet.Shapes tc = shp.BottomRightCell.Column tr = shp.BottomRightCell.Row If (tc >= PrimeraColumna And tc <= UltimaColumna) And _ (tr >= PrimeraFila And tr <= UltimaFila) Then shp.Delete Cuenta = Cuenta + 1 Else End If Next MsgBox "Se ha Impreso y Guardado lo solicitado" Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub pruebaFINAL.xlsm
  14. @johnmpl excelente amigo muchas gracias funciona perfecto.
×
×
  • Create New...

Important Information

Privacy Policy

Ayuda Excel - Madrid, Madrid, ES - Valorada por 5112 personas - Aprender Excel - Total: 4.7 / 5