Seleccionar un directorio y guardar copia excel o pdf

Para Dante

Buenos días Dante, necesito otra vez de tu apoyo. Necesito que me muestre una ventana para elegir el directorio y guardar, dependiendo de la opción que yo elija. De ya gracias.

Private Sub CommandButton4_Click()
 Application.ScreenUpdating = False
    Set h1 = Sheets("BIBLIOTECA")
    Ruta = ThisWorkbook.Path & "\"
    arch = "Reporte"
    '
    If ComboBox1 = "" Or ComboBox1.ListIndex = -1 Then
    MsgBox "Seleccione un reporte"
    Exit Sub
    End If
    '
    If OptionButton1 Then
    h1.Copy
    'guarda archivo como versión 2007 o superior
    ActiveWorkbook.SaveAs _
        Filename:=Ruta & arch & " " & Format(Time, "hh-mm-ss") & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook
        ActiveWorkbook.Close
        Application.ScreenUpdating = True
        MsgBox "Fin"
        habilitado = False
        Unload Me
        FrmInicio.Show
    End If
    '
    If OptionButton2 Then
        h1.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Ruta & arch & Format(Date, "yyyy-mm-dd") & ".pdf", _
        quality:=xlQualityStandard, includedocproperties:=True, _
        ignorePrintAreas:=False, openAfterPublish:=False
        Application.ScreenUpdating = True
        MsgBox "Fin"
        habilitado = False
        Unload Me
        FrmInicio.Show
    End If
    If OptionButton3 Then
    MsgBox "Seguimos trabajando", vbInformation, Strtitulo
    Exit Sub
    'Por.DAM
'    Application.ScreenUpdating = False
'    Application.DisplayAlerts = False
'    If Range("A1") = "" Then Exit Sub
'    n = Range("A1")
'    Range("C2:O30").Copy
'    Workbooks.Add
'    ActiveSheet.Paste
'        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ARCHIVO\" & n & ".txt", _
'            FileFormat:=xlTextMSDOS, CreateBackup:=False
'        ActiveWorkbook.Close False
'    MsgBox "Archivo: " & n & " creado", vbInformation, "CREAR TXT"
    End If
End Sub

1 Respuesta

Respuesta
1

Código actualizado

Private Sub CommandButton4_Click()
    Application.ScreenUpdating = False
    Set h1 = Sheets("BIBLIOTECA")
    ruta = ThisWorkbook.Path & "\"
    arch = "Reporte"
    '
    If ComboBox1 = "" Or ComboBox1.ListIndex = -1 Then
        MsgBox "Seleccione un reporte"
        Exit Sub
    End If
    '
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Selecciona una carpeta"
        .AllowMultiSelect = False
        .InitialFileName = ruta
        If .Show <> -1 Then Exit Sub
        ruta = .SelectedItems(1) & "\"
    End With
    If OptionButton1 Then
        h1.Copy
        'guarda archivo como versión 2007 o superior
        ActiveWorkbook.SaveAs _
            Filename:=ruta & arch & " " & Format(Time, "hh-mm-ss") & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook
        ActiveWorkbook.Close
        Application.ScreenUpdating = True
        MsgBox "Fin"
        habilitado = False
        Unload Me
        FrmInicio.Show
    End If
    '
    If OptionButton2 Then
        h1.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ruta & arch & Format(Date, "yyyy-mm-dd") & ".pdf", _
        quality:=xlQualityStandard, includedocproperties:=True, _
        ignorePrintAreas:=False, openAfterPublish:=False
        Application.ScreenUpdating = True
        MsgBox "Fin"
        habilitado = False
        Unload Me
        FrmInicio.Show
    End If
    If OptionButton3 Then
        MsgBox "Seguimos trabajando", vbInformation, Strtitulo
        Exit Sub
        'Por.DAM
    '    Application.ScreenUpdating = False
    '    Application.DisplayAlerts = False
    '    If Range("A1") = "" Then Exit Sub
    '    n = Range("A1")
    '    Range("C2:O30").Copy
    '    Workbooks.Add
    '    ActiveSheet.Paste
    '        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ARCHIVO\" & n & ".txt", _
    '            FileFormat:=xlTextMSDOS, CreateBackup:=False
    '        ActiveWorkbook.Close False
    '    MsgBox "Archivo: " & n & " creado", vbInformation, "CREAR TXT"
    End If
End Sub

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas