VBA prostředí | Jak používat funkci Environ ve VBA Excel?
Excel VBA ENVIRON (prostředí)
Funkce VBA ENVIRON (znamená ENVIRONMENT ), kterou lze kategorizovat jako informační funkci, protože tato funkce vrací hodnoty proměnných prostředí operačního systému. Proměnné prostředí (operační systém) obsahují informace o profilech všech uživatelů, uživatelské jméno, profil uživatele, domovskou složku uživatele atd. Tato funkce vrací hodnotu řetězce.
Syntax
Tato funkce má pouze jeden argument, kterým je výraz . Můžeme určit číselnou pozici (celočíselnou hodnotu) představující číselnou pozici proměnné prostředí v tabulce proměnných prostředí nebo v samotném názvu proměnné .
Pokud zadáme číselnou pozici, vrátí funkce proměnnou prostředí a její hodnotu se stejným znaménkem mezi nimi.
Pokud zadáme název proměnné, funkce vrátí pouze jedinou hodnotu.
Výstup:
Jak používat funkci Environ ve VBA?
Tuto šablonu VBA ENVIRON Excel si můžete stáhnout zde - Šablona VBA ENVIRON ExcelPříklad č. 1
Otevřete příkazový řádek pomocí funkce ENVIRON ve VBA .
Stejné kroky by byly:
Vložte příkazové tlačítko pomocí příkazu „Vložit“ dostupného ve skupině „Ovládací prvky“ na kartě „Vývojář“ nebo použijte klávesovou zkratku Excel ( Alt + F11 ).
Pokud karta „Vývojář“ není viditelná, zviditelněte ji pomocí následujících kroků.
Klikněte na „Soubor“ a ze seznamu vyberte „Možnosti“ .
V nabídce vlevo vyberte možnost „Přizpůsobit pás karet“, zaškrtněte políčko na kartě „Vývojář“ a klikněte na tlačítko „OK“ .
Nyní je viditelná karta Vývojář .
Při vkládání příkazového tlačítka, pokud stále stiskneme klávesu ALT , budou hrany příkazového tlačítka spolu s ohraničením buněk. Změňte vlastnosti vloženého příkazového tlačítka pomocí kontextového menu, které získáme kliknutím pravým tlačítkem na „příkazové tlačítko“ .
Okno Vlastnosti
Chcete-li napsat kód VBA pro příkazové tlačítko, musíme vybrat příkazové tlačítko a v kontextové nabídce zvolit možnost „Zobrazit kód“ .
Napište kód následovně:
Zavolali jsme funkci 'Shell' pro zadání příkazu ke spuštění programu (v našem případě je to příkazový řádek).
Použili jsme 'ComSpec' , což je zkratka pro 'Command Specifier' .
Nyní ukončete VBE a klikněte na příkazové tlačítko. Zobrazili jsme příkazový řádek.
Příklad č. 2
Předpokládejme, že chceme extrahovat názvy souborů a podrobnosti pro vybranou složku následujícím způsobem.
Postup je stejný:
Naplňte buňky B2: H9 světle oranžovou barvou.
Vytvořte štítek pomocí příkazu „Vložit“ ve skupině „Ovládací prvky“ ve složce „Vývojář“.
Vytvořte níže zobrazené štítky a upravte vlastnosti jako titulek , BackColor , BackStyle , BorderStyle , Shadow
Vytvořte pole se seznamem následujícím způsobem pomocí příkazu pole se seznamem (jeden z ovládacích prvků ActiveX), který je k dispozici v příkazu Vložit ve skupině Ovládací prvky ve vývojáři.
Po vytvoření pole se seznamem v aplikaci Excel následujícím způsobem můžeme změnit vlastnosti.
Přidáme kód pro seznam, který se má zobrazit v rozevíracím seznamu pomocí příkazu Zobrazit kód v kontextové nabídce.
Je to kód pro ComboBox „Select the Folder“ .
Je to kód pro „ SortBy“ ComboBox.
Je to kód pro ComboBox „Select the Order“ .
Vytvoříme seznam obsahující všechny typy souborů, aby je uživatel mohl vybrat, aby ve výsledku získal pouze tyto typy souborů. Chcete-li udělat totéž, zvolte „ Seznam (ovládací prvek ActiveX) “ z příkazu „ Vložit “ ve skupině „ Ovládací prvky “ na kartě „ Vývojář “.
Přetáhněte seznam, jak je znázorněno níže.
Změňte vlastnosti seznamu takto.
Chcete-li přidat typy souborů do seznamu, použijte následující kód.
Napište kód do „tohoto sešitu“.
Kód:
Private Sub Workbook_Open () Dim ArrFileType (25) As Variant ArrFileType (0) = "List Microsoft Excel 97-2003 (.xls)" ArrFileType (1) = "List Microsoft Office Excel (.xlsx)" ArrFileType (2) = " Microsoft Excel Macro-Enabled Worksheet (.xlsm) "ArrFileType (3) =" Word Document 97-2003 (.doc) "ArrFileType (4) =" Word Document 2007-2010 (.docx) "ArrFileType (5) =" Text Document (.txt) "ArrFileType (6) =" Dokument Adobe Acrobat (.pdf) "ArrFileType (7) =" Komprimovaná (komprimovaná) složka (.Zip) "ArrFileType (8) =" archiv WinRAR (.rar) "ArrFileType (9) = "Nastavení konfigurace (.ini)" ArrFileType (10) = "Soubor GIF (.gif)" ArrFileType (11) = "Soubor PNG (.png)" ArrFileType (12) = "Soubor JPG (.jpg) "ArrFileType (13) =" Zvuk ve formátu MP3 (.mp3) "ArrFileType (14) = "Soubor M3U (.m3u)" ArrFileType (15) = "Formát RTF (.rtf)" ArrFileType (16) = "Video MP4 (.mp4)" ArrFileType (17) = "Videoklip (. avi) "ArrFileType (18) =" Windows Media Player (.mkv) "ArrFileType (19) =" SRT soubor (.srt) "ArrFileType (20) =" soubor PHP (.php) "ArrFileType (21) =" Firefox Dokument HTML (.htm, .html) "ArrFileType (22) =" Dokument kaskádových stylů (.css) "ArrFileType (23) =" Soubor skriptu JScript (.js) "ArrFileType (24) =" Dokument XML (.xml) ) "ArrFileType (25) =" Windows Batch File (.bat) "Sheet2.FileTypesListBox.List = ArrFileType End Subavi) "ArrFileType (18) =" Windows Media Player (.mkv) "ArrFileType (19) =" SRT soubor (.srt) "ArrFileType (20) =" soubor PHP (.php) "ArrFileType (21) =" Firefox Dokument HTML (.htm, .html) "ArrFileType (22) =" Dokument kaskádových stylů (.css) "ArrFileType (23) =" Soubor skriptu JScript (.js) "ArrFileType (24) =" Dokument XML (.xml) ) "ArrFileType (25) =" Windows Batch File (.bat) "Sheet2.FileTypesListBox.List = ArrFileType End Subavi) "ArrFileType (18) =" Windows Media Player (.mkv) "ArrFileType (19) =" SRT soubor (.srt) "ArrFileType (20) =" soubor PHP (.php) "ArrFileType (21) =" Firefox Dokument HTML (.htm, .html) "ArrFileType (22) =" Dokument kaskádových stylů (.css) "ArrFileType (23) =" Soubor skriptu JScript (.js) "ArrFileType (24) =" Dokument XML (.xml) ) "ArrFileType (25) =" Windows Batch File (.bat) "Sheet2.FileTypesListBox.List = ArrFileType End SubArrFileType (24) = "Dokument XML (.xml)" ArrFileType (25) = "Dávkový soubor Windows (.bat)" Sheet2.FileTypesListBox.List = ArrFileType End SubArrFileType (24) = "Dokument XML (.xml)" ArrFileType (25) = "Dávkový soubor Windows (.bat)" Sheet2.FileTypesListBox.List = ArrFileType End Sub
Vložte zaškrtávací políčka pomocí stejného příkazu „ Vložit “ do skupiny „ Ovládací prvky “ na kartě „ Vývojář “ a změňte vlastnosti vložených „zaškrtávacích políček“ pomocí příkazu „Vlastnosti“ dostupného ve stejné skupině po výběru objektů.
Vložte příkazová tlačítka pomocí příkazu „Vložit“, který je k dispozici ve stejné skupině, a změňte také vlastnosti, jako je titulek a další vlastnosti.
Vytvořili jsme celou strukturu. Nyní musíme napsat kód.
Aktivujte „Režim návrhu“ a klikněte pravým tlačítkem na tlačítko „ Načíst všechny podrobnosti souborů “, abyste vybrali „ Zobrazit kód “ z kontextové nabídky a přidali kód pro tlačítko.
Nejprve deklarujeme nějakou proměnnou v modulu.
Níže je kód přidán k tlačítku „ Načíst všechny soubory “.
Kód:
Private Sub FetchFilesBtnCommandButton_Click () iRow = 14 fPath = Environ ("HOMEPATH") & "\" & SelectTheFolderComboBox.Value If fPath "" Then Set FSO = New Scripting.FileSystemObject If FSO.FolderExists (fPath) False = Then GetFolder (fPath) If Sheet2.IncludingSubFoldersCheckBox.Value = True Then IsSubFolder = True Else IsSubFolder = False If SourceFolder.Files.Count = 0 Then MsgBox "V této složce neexistují žádné soubory" & vbNewLine & vbNewLine & "Zkontrolovat cestu a" Again !! ", vbInformation Exit Sub End If End If Call ClearResult If FetchAllTypesOfFilesCheckBox.Value = True Then Call ListFilesInFolder (SourceFolder, IsSubFolder) Call ResultSorting (xlAscending," C14 "," D14 "," E14 ") Else Call ListFiles ,IsSubFolder) Volání ResultSorting (xlAscending, "C14", "D14", "E14") Konec, pokud FilesCountLabel.Caption = iRow - 14 Else MsgBox "Vybraná cesta neexistuje !!" & vbNewLine & vbNewLine & "Vyberte Správný a zkuste to znovu !!", vbInformation Konec, pokud Else MsgBox "Cesta ke složce nemůže být prázdná !!" & vbNewLine & vbNewLine & "", vbInformation End If End SubvbInformation End If End SubvbInformation End If End Sub
Definujte funkci 'ClearResult' v modulu. Chcete-li vložit modul, vyberte „ThisWorkbook“, poté „Vložit“ a poté „Modul“.
Napište následující kód do modulu.
Kód pro ClearResult
Existuje více podprogramů jako 'ListFilesInFolder' , 'ListFilesInFolderXtn' , 'ResultSorting' , všechny tyto podprogramy definujeme v modulu.
'ListFilesInFolder'
Kód:
Public Sub ListFilesInFolder (SourceFolder As Scripting.Folder, IncludeSubfolders As Boolean) On Error Resume Next For each FileItem In SourceFolder.Files 'display file properties Cells (iRow, 2) .Formula = iRow - 13 Cells (iRow, 3) .Formula = FileItem.Name Cells (iRow, 4) .Formula = FileItem.Path Cells (iRow, 5) .Formula = Int (FileItem.Size / 1024) Cells (iRow, 6) .Formula = FileItem.Type Cells (iRow, 7) .Formula = FileItem.DateLastModified Cells (iRow, 8). Vyberte Selection.Hyperlinks.Add Anchor: = Selection, Address: = _ FileItem.Path, TextToDisplay: = "Kliknutím sem otevřete buňky" (iRow, 8) .Formula = "= HYPERLINK (" "" & FileItem.Path & "" "," "" a "Kliknutím sem otevřete" & "" ")" iRow = iRow + 1 'číslo dalšího řádku Další FileItem If IncludeSubfolders Then For each SubFolder In SourceFolder.SubFolders ListFilesInFolder SubFolder, True Next SubFolder End If Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
'ListFilesInFolderXtn'
Public Sub ListFilesInFolderXtn (SourceFolder As Scripting.Folder, IncludeSubfolders As Boolean) On Error Resume Next Dim FileArray as Variant FileArray = Get_File_Type_Array for each FileItem in SourceFolder.Files Call ReturnFileType (FileItem.Type, FileArray Then Is 2) .Formula = iRow - 13 buněk (iRow, 3) .Formula = FileItem.Name buňky (iRow, 4) .Formula = FileItem.Path buňky (iRow, 5) .Formula = Int (FileItem.Size / 1024) buněk (iRow, 6) .Formula = FileItem.Type Cells (iRow, 7) .Formula = FileItem.DateLastModified Cells (iRow, 8). Select Selection.Hyperlinks.Add Anchor: = Selection, Address: = _ FileItem.Path, TextToDisplay : = "Kliknutím sem otevřete buňky" (iRow, 8) .Formula = "= HYPERLINK (" "" & FileItem.Path & "" "," "" & "Kliknutím sem otevřete" &"" ")" iRow = iRow + 1 'číslo dalšího řádku Konec, pokud další FileItem, pokud IncludeSubfolders, pak pro každou podsložku v SourceFolder.SubFolders ListFilesInFolderXtn SubFolder, True Next SubFolder Konec, pokud Set FileItem = Nic Nastavit SourceFolder = Nic Nastavit FSO = Nic Konec Sub Sub
'ResultSorting'
Sub ResultSorting (xlSortOrder As String, sKey1 As String, sKey2 As String, sKey3 As String) Range ("C13"). Select Range (Selection, Selection.End (xlDown)). Select Range (Selection, Selection.End (xlToRight) ) .Select Selection.Sort Key1: = Range (sKey1), Order1: = xlSortOrder, Key2: = Range (sKey2 _), Order2: = xlAscending, Key3: = Range (sKey3), Order3: = xlSortOrder, Header _: = xlGuess, OrderCustom: = 1, MatchCase: = False, Orientace: = xlTopToBottom _, DataOption1: = xlSortNormal, DataOption2: = xlSortNormal, DataOption3: = _ xlSortNormal Range ("B14"). Vyberte End Sub
V podprogramu 'ListFilesInFolderXtn' jsme nazvali funkci s názvem 'ReturnFileType' a 'GetFileTypeArray' , musíme definovat funkce ve stejném modulu.
'ReturnFileType'
Kód:
Public Function ReturnFileType (fileType As String, FileArray As Variant) As Boolean Dim i As Integer IsFileTypeExists = False For i = 1 To UBound (FileArray) + 1 If FileArray (i - 1) = fileType Then IsFileTypeExists = True Exit for Else IsFileTypeExists = False End If Next End Function
'GetFileTypeArray'
Kód:
Veřejná funkce Get_File_Type_Array () As Variant Dim i, j, TotalSelected As Integer Dim arrList () As String TotalSelected = 0 For i = 0 To Sheet2.FileTypesListBox.ListCount - 1 If Sheet2.FileTypesListBox.Selected (i) = True Then TotalSelected = TotalSelected + 1 End If Next ReDim arrList (0 To TotalSelected - 1) As String j = 0 i = 0 For i = 0 To Sheet2.FileTypesListBox.ListCount - 1 If Sheet2.FileTypesListBox.Selected (i) = True Then arrList (j ) = Left (Sheet2.FileTypesListBox.List (i), InStr (1, Sheet2.FileTypesListBox.List (i), "(") - 1) j = j + 1 End If Next Get_File_Type_Array = arrList End Function
Máme příkazové tlačítko s titulkem „Exportovat do souboru Excel“ , kód tohoto tlačítka musíme napsat následovně:
V modulu definujte podprogram s názvem 'Export_to_excel' .
Kód:
Sub Export_to_excel () On Error GoTo err Dim xlApp As New Excel.Application Dim xlWB As New Workbook Set xlWB = xlApp.Workbooks.Add 'xlWB.Add xlApp.Visible = False ThisWorkbook.Activate Range ("B13"). Select Range ( Selection, Selection.End (xlDown)). Vyberte rozsah (Selection, Selection.End (xlToRight)). Vyberte Selection.Copy xlApp.Visible = True xlWB.Activate xlWB.Sheets ("Sheet1"). Select xlWB.Sheets (" List1 "). Rozsah (" B2 "). PasteSpecial Paste: = xlPasteValues xlWB.Sheets (" Sheet1 "). Cells.Select xlWB.Sheets (" Sheet1 "). Cells.EntireColumn.AutoFit xlWB.Sheets (" Sheet1 ") .Range ("B2"). Vyberte možnost Exit Sub err: MsgBox ("Při exportu došlo k chybě. Zkuste to znovu") End Sub
Máme ještě jedno příkazové tlačítko s titulkem „Export do textového souboru“ . Kód příkazového tlačítka napíšeme následovně:
V tomto kódu vidíme, že máme uživatelský formulář, který musíme navrhnout pomocí následujících kroků:
Klikněte pravým tlačítkem na list „List2 (příklad 2)“ a v nabídce vyberte „Vložit“ a poté „UserForm“ .
Navrhněte UserForm pomocí nástrojů z panelu nástrojů.
Použili jsme ‚Štítky‘ , ‚Combo Box‘ , ‚Text Box‘ a ‚Tlačítka‘ na UserForm a změnily titulek a název pro všechny komponenty.
Pro první příkazové tlačítko (OK) musíme napsat kód následovně:
Kód:
Private Sub CommandButton1_Click () Dim iSeperator jako řetězec If ComboBox1.Value = "Other" Then iSeperator = TextBox1.Value Else iSeperator = ComboBox1.Value End If If iSeperator = "" Then If MsgBox ("Hello You have not selected any delimeter." & vbNewLine & vbNewLine & _ "Bude velmi obtížné číst textový soubor bez zvláštního oddělovače", vbYesNo) = vbYes Potom zavolat textový soubor (iSeperator) Else Exit Sub End If Else Select Case ComboBox1.ListIndex Case 0: iSeperator = " , "Případ 1: iSeperator =" | " Případ 2: iSeperator = "vbTab" Případ 3: iSeperator = ";" End Select Call textfile (iSeperator) Unload Me End If End Sub
V podprogramu příkazového tlačítka jsme nazvali funkci 'textový soubor' , proto musíme v modulu definovat funkci 'textový soubor' .
Kód:
Dílčí textový soubor (iSeperator jako řetězec) Dim iRow, iCol Dim iLine, f ThisWorkbook.Activate Range ("B13"). Select TotalRowNumber = Range (Selection, Selection.End (xlDown)). Count - 12 If iSeperator "vbTab" Then Open ThisWorkbook.Path & "\ File1.txt" Pro výstup jako # 1 Tisk # 1, "" Zavřít # 1 Otevřít ThisWorkbook.Path & "\ File1.txt" Pro připojení jako # 1 Pro iRow = 13 To TotalRowNumber iLine = "" Pro iCol = 2 až 7 iLine = iLine & iSeperator & Cells (iRow, iCol). Hodnota Next Print # 1, iLine Next Close # 1 Else Open ThisWorkbook.Path & "\ File1.txt" For Output As # 1 Print # 1 , "" Zavřít # 1 Otevřít ThisWorkbook.Path & "\ File1.txt" Přidat jako # 1 Pro iRow = 13 To TotalRowNumber iLine = "" Pro iCol = 2 až 7 iLine = iLine & vbTab & Cells (iRow, iCol) .Hodnota Další Tisk č. 1, iLine Další Zavřít # 1 Konec Pokud f = Shell ("C: \ WINDOWS \ notepad.exe" & ThisWorkbook.Path & "\ File1.txt", vbMaximizedFocus) MsgBox "Váš soubor je uložen v" & ThisWorkbook.Path & "\ File1.txt" End Sub
Pro příkazové tlačítko 2 (Storno) musíme napsat následující kód. Dvojitým kliknutím na tlačítko Storno napíšete kód.
Do pole se seznamem pro výběr specifikátoru napište následující kód.
Pro UserForm napište následující kód.
Do zaškrtávacího políčka „Načíst všechny typy souborů“ napište následující kód.
Pro 'ListBox' pro typy souborů napište následující kód.
Pro ‚SelectTheOrder‘ pole se seznamem, napsat následující kód.
Kód:
Soukromý sub SelectTheOrderComboBox_Change () Select Case (SelectTheOrderComboBox.Value) Case "Ascending" If SortByComboBox.Value = "File name" Then Call ResultSorting (xlAscending, "C14", "E14", "G14") End If If SortByComboBox.Value "Typ souboru" Pak zavolejte ResultSorting (xlAscending, "F14", "E14", "C14") Konec, pokud If SortByComboBox.Value = "Velikost souboru" Pak zavolejte ResultSorting (xlAscending, "E14", "C14", "G14" ) End If If SortByComboBox.Value = "Last Modified" Then Call ResultSorting (xlAscending, "G14", "C14", "E14") End If Case "Descending" If SortByComboBox.Value = "File Name" Then Call ResultSorting (xlDescending , „C14“, „E14“, „G14“) Konec, pokud If SortByComboBox.Value = "Typ souboru", pak volejte ResultSorting (xlDescending, "F14", "E14", "C14") Konec, pokud, pokud SortByComboBox.Value = "Velikost souboru" Pak volejte ResultSorting (xlDescending, "E14" , "C14", "G14") End If If SortByComboBox.Value = "Last Modified" Then Call ResultSorting (xlDescending, "G14", "C14", "E14") End If Case Default Exit Sub End Select End SubPotom volejte ResultSorting (xlDescending, "G14", "C14", "E14") End If Case Default Exit Sub End Select End SubPotom volejte ResultSorting (xlDescending, "G14", "C14", "E14") End If Case Default Exit Sub End Select End Sub
Pro ‚SortBy‘ pole se budeme psát následující kód.
Kód:
Soukromý sub SortByComboBox_Change () Vybrat případ (SelectTheOrderComboBox.Value) Případ "Vzestupně" If SortByComboBox.Value = "Název souboru" Potom zavolat ResultSorting (xlAscending, "C14", "E14", "G14") Končit, pokud SortByComboBox.Value = "Typ souboru" Pak zavolejte ResultSorting (xlAscending, "F14", "E14", "C14") Konec, pokud If SortByComboBox.Value = "Velikost souboru" Pak zavolejte ResultSorting (xlAscending, "E14", "C14", "G14" ) End If If SortByComboBox.Value = "Last Modified" Then Call ResultSorting (xlAscending, "G14", "C14", "E14") End If Case "Descending" If SortByComboBox.Value = "File Name" Then Call ResultSorting (xlDescending , „C14“, „E14“, „G14“) Konec, pokud If SortByComboBox.Value = "Typ souboru", pak volejte ResultSorting (xlDescending, "F14", "E14", "C14") Konec, pokud, pokud SortByComboBox.Value = "Velikost souboru" Pak volejte ResultSorting (xlDescending, "E14" , "C14", "G14") End If If SortByComboBox.Value = "Last Modified" Then Call ResultSorting (xlDescending, "G14", "C14", "E14") End If Case Default Exit Sub End Select End Sub"G14", "C14", "E14") Konec, pokud je případ Výchozí Konec Sub Konec Vyberte Konec Sub"G14", "C14", "E14") Konec, pokud je případ Výchozí Konec Sub Konec Vyberte Konec Sub
Nyní jsme napsali celý kód. Nyní můžeme vybrat požadovanou složku a typ souboru a vyhledat seznam souborů, které můžeme řadit, podle 'Název souboru', 'Typ souboru', 'Velikost souboru' nebo 'Last-Modified' a můžeme exportovat seznam do Excel nebo textový soubor.
Věci k zapamatování
Pokud hodnota, kterou zadáme pro argument 'envstring', není v tabulce řetězců prostředí, vrátí funkce ENVIRON řetězec nulové délky.
