none
Macro para abrir archivo excel en una plantilla RRS feed

  • Pregunta

  • Buenos días, estoy realizando una macro para abrir un archivo de excel, pero quiero que se abra en el mismo archivo donde tengo el bóton abrir archivo,

    Archivo = Application.GetOpenFilename _
    ("Arcivos Microsoft Excel (*.xls), *.xls", , "Abrir Archivo")
    If Archivo <> False Then
    Workbooks.Open Archivo
    End If

    Este es el código que estoy usando, pero lo abre en un archivo diferente, lo que quiero es que lo abra en la misma hoja donde tengo ese botón, es que cuando tenga ese archivo tengo que generar un archivo plano, para eso uso el sgt código

    Dim strSpc As String '<== la nueva variable propuesta
    Dim HojaPol As Worksheet
    Dim intFich As Integer, lngNumReg As Long, strCad As String, strCar As String * 1
    Dim lngContL As Long, intContC As Integer, N As Long
    Set HojaPol = Worksheets("Hoja1") 'hoja donde estan los datos
    intFich = FreeFile(0)
    lngContL = 3 'se empezara a exportar en la fila 2 (se entiende que la 1ª es de títulos)
    intContC = 12 'se exportaran las columnas 1 a 6
    If Dir("C:\Fichero.txt") <> "" Then Kill ("C:\Fichero.txt") 'si ya existe C:\Fichero.txt, lo borra.
    Open "C:\Fichero.txt" For Random As intFich Len = 1
    While Not IsEmpty(HojaPol.Cells(lngContL, 1))
    For N = 1 To intContC
    If intContC = 2 Then '<== el If 'interceptor' de la columna 2
    strSpc = String(10 - Len(HojaPol.Cells(lngContL, N + 1)), " ") '<== 'habra' 10 espacios MENOS los que ocupe la col. 3
    Else: strSpc = "," '<== para todos los demas casos, las columnas se separan por solo un espacio
    End If
    strCad = strCad & Format(HojaPol.Cells(lngContL, N), HojaPol.Cells(lngContL, N).NumberFormat) & strSpc '<== los 'necesarios'
    Next N
    strCad = Left(strCad, Len(strCad) - 1) & vbNewLine 'para quitar el ultimo delimitador por la derecha y añadir el salto de linea
    For N = 1 To Len(strCad)
    strCar = Mid(strCad, N, 1)
    lngNumReg = lngNumReg + 1
    Put intFich, lngNumReg, strCar
    Next N
    lngContL = lngContL + 1
    strCad = ""
    Wend
    Close intFich
    Set HojaPol = Nothing

    Lo estoy realizando de esa manera porque la información que necesito para generar el archivo plano se encuentra en una ubicación diferente de donde estoy realizando la macro, hay una carpeta general, dentro de esa hay unas carpetas por semana, aquí yo escojo la semana y dentro de esas hay carpetas por días, la información la tengo que generar diariamente, lo que pretendo es escoger el archivo del día x y generar el archivo plano

    Gracias de antemano

    jueves, 21 de marzo de 2013 17:15

Respuestas

  • Buenas lo que hice fue abrir el archivo que contiene la información del cliente(ésta información es diaria) ycopiar las columnas que necesitaba que estuvieran en mi plantilla, les dijo el código

    Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Application.Dialogs(xlDialogOpen).Show
    nombre = ActiveWorkbook.Name
    ActiveSheet.Range("A3:A70").Select
        Selection.Copy
    Windows("Prueba formato EDI APL.xlsm").Activate
        Range("C3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Windows(nombre).Activate
    ActiveSheet.Range("D3:D70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("B3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Windows(nombre).Activate
    ActiveSheet.Range("F3:F70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("D3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Windows(nombre).Activate
    ActiveSheet.Range("G3:G70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("F3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            Windows(nombre).Activate
    ActiveSheet.Range("Q3:Q70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("I3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            Windows(nombre).Activate
    ActiveSheet.Range("O3:O70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("J3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            Windows(nombre).Activate
    ActiveSheet.Range("N3:N70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("K3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    End Sub


    • Marcado como respuesta Uriel Almendra viernes, 22 de marzo de 2013 21:22
    viernes, 22 de marzo de 2013 16:25

Todas las respuestas

  • Buenas lo que hice fue abrir el archivo que contiene la información del cliente(ésta información es diaria) ycopiar las columnas que necesitaba que estuvieran en mi plantilla, les dijo el código

    Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Application.Dialogs(xlDialogOpen).Show
    nombre = ActiveWorkbook.Name
    ActiveSheet.Range("A3:A70").Select
        Selection.Copy
    Windows("Prueba formato EDI APL.xlsm").Activate
        Range("C3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Windows(nombre).Activate
    ActiveSheet.Range("D3:D70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("B3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Windows(nombre).Activate
    ActiveSheet.Range("F3:F70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("D3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Windows(nombre).Activate
    ActiveSheet.Range("G3:G70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("F3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            Windows(nombre).Activate
    ActiveSheet.Range("Q3:Q70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("I3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            Windows(nombre).Activate
    ActiveSheet.Range("O3:O70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("J3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            Windows(nombre).Activate
    ActiveSheet.Range("N3:N70").Select
        Selection.Copy
     Windows("Prueba formato EDI APL.xlsm").Activate
        Range("K3").Select
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    End Sub


    • Marcado como respuesta Uriel Almendra viernes, 22 de marzo de 2013 21:22
    viernes, 22 de marzo de 2013 16:25
  • Puedes abrir unos excel documentos via ¿Cómo reparar archivos dañados de Excel 2007?

    El tema asistio a traves de http://www.excel.repairtoolboxx.com/es

    domingo, 2 de junio de 2013 23:05