vbscript Dialogyprovýběr，otevřeníauloženísouborů

Posted 2021-05-22

Sub DialogVyberSlozky()

    'viceucelovy dialog, zde pro vyber slozky
    With Application.FileDialog(msoFileDialogFolderPicker)
        
        'titulek, bezne "Prochazet"
        .Title = "Vyber slozky"
        
        'vychozi styl zobrazeni, zde nahledy obsahu slozek
        'Windows 7, 64 bit, nefunkcni
        .InitialView = msoFileDialogViewLargeIcons
        
        'vicenasobny vyber slozek nelze pouzit
        '.AllowMultiSelect = True
        
        'vychozi zobrazena slozka, zde Temp
        .InitialFileName = Environ("Temp")
        
        'popis tlacitka, bezne "OK"
        .ButtonName = "Vybrat"

        'zobrazeni dialogu
        .Show
        
        'byla vybrana slozka?
        If .SelectedItems.Count > 0 Then
            
            'vypis do okna Immediate
            Debug.Print .SelectedItems(1)
            
        End If
        
    End With

End Sub

Sub DialogVyberSouboru()

    Dim i As Integer

    'viceucelovy dialog, zde pro vyber souboru
    With Application.FileDialog(msoFileDialogFilePicker)
    
        'vicenasobny vyber souboru
        .AllowMultiSelect = False
        
        'vychozi zobrazena slozka, zde Temp
        .InitialFileName = Environ("Temp")
        
        'zobrazeni dialogu
        .Show
        
        'byl vybran nejaky soubor?
        If .SelectedItems.Count > 0 Then
        
            'pro kazdou vybranou polozku
            For i = 1 To .SelectedItems.Count
            
                'vypis do okna Immediate
                Debug.Print .SelectedItems(i)
                
            Next i
            
        End If
        
    End With

End Sub

Sub DialogVyberSouboruFiltr()

    Dim i As Integer

    'viceucelovy dialog, zde pro vyber souboru
    With Application.FileDialog(msoFileDialogFilePicker)

        'vicenasobny vyber souboru
        .AllowMultiSelect = True

        'vychozi zobrazena slozka, zde slozka tohoto souboru
        .InitialFileName = ThisWorkbook.Path

        'pridani dvou filtru
        .Filters.Add "Vybrane typy obrazku", _
            "*.gif; *.jpg; *.jpeg; *.bmp; *.png", 1
        .Filters.Add "Soubory aplikace Excel", "*.xl*", 2

        'vychozi druhy filtr
        .FilterIndex = 2

        'zobrazeni dialogu
        .Show

        'byl vybran nejaky soubor?
        If .SelectedItems.Count > 0 Then
            'alternativne If .Show = -1 then

            'pro kazdou vybranou polozku
            For i = 1 To .SelectedItems.Count

                'vypis do okna Immediate
                Debug.Print .SelectedItems(i)

            Next i

        End If

    End With

End Sub

Sub DialogSouborOtevrit()

    Dim i As Integer

    'viceucelovy dialog
    'zde pro vyber a otevreni souboru
    'a to pouze takovych, ktere jsou pridruzene
    'hostitelske aplikaci, tj. Microsoft Excel!
    With Application.FileDialog(msoFileDialogOpen)

        'vicenasobny vyber souboru
        .AllowMultiSelect = False

        'vychozi zobrazena slozka, zde Temp
        .InitialFileName = ThisWorkbook.Path

        'zobrazeni dialogu
        .Show

        'byl vybran nejaky soubor?
        If .SelectedItems.Count > 0 Then
        
            'spusteni
            .Execute

        End If

    End With

End Sub

Sub DialogSouborOtevritAlternativa()

    Dim varFName As Variant
    Dim i As Integer

    'metoda GetOpenFilename
    varFName = _
        Application.GetOpenFilename( _
        FileFilter:="Soubory aplikace Excel (*.xl*), *.xl*", _
        MultiSelect:=True)

    If IsArray(varFName) Then
        For i = LBound(varFName) To UBound(varFName)
            'otevreni sesitu
            Workbooks.Open (varFName(i))
        Next
    End If

End Sub

Sub DialogUlozitJako()

    Dim varSouborNazev As Variant

    'vynuceny nazev souboru
    'Do
    '    varSouborNazev = Application.GetSaveAsFilename
    'Loop Until varSouborNazev <> False

    varSouborNazev = Application.GetSaveAsFilename(ThisWorkbook.Name)

    If varSouborNazev <> False Then
        ThisWorkbook.SaveAs (varSouborNazev)
    End If

End Sub