photosdematures.com

Excel VBA ENVIRON (entorn)

El VBA ENVIRON funció (significa MEDI AMBIENT) que es pot classificar com a funció d'informació, ja que aquesta funció retorna els valors de les variables d'entorn d'un sistema operatiu. Les variables d'entorn (sistema operatiu) contenen informació sobre perfils de tots els usuaris, nom d'usuari, perfil d'usuari, una carpeta inicial per a l'usuari, etc. Aquesta funció retorna un valor de cadena.

Sintaxi

Aquesta funció només té un argument que és "Expressió‘. Podem especificar el posició numèrica (valor enter) que representa la posició numèrica de la variable d'entorn a la taula de variables d'entorn o nom de la variable a si mateix.

Si especifiquem la posició numèrica, la funció retorna la variable d'entorn i el seu valor amb un signe igual entre els dos.

Si especifiquem el nom de la variable, la funció retorna l'únic valor.

Sortida:

Com s'utilitza la funció Environ a VBA?

Podeu descarregar aquesta plantilla Excel VBA ENVIRON aquí - Plantilla Excel VBA ENVIRON

Exemple 1

Obriu el símbol del sistema mitjançant la funció ENVIRON a VBA.

Per fer el mateix, els passos serien:

Inseriu el botó d'ordres mitjançant "Insereix" disponible a la comanda "Controls" grup al 'Desenvolupador' o utilitzeu la tecla Excel de drecera (Alt + F11).

Si el 'Desenvolupador' la pestanya no és visible i, a continuació, feu els passos següents per fer-la visible.

Fer clic a 'Dossier' i tria "Opcions" de la llista.

Trieu "Personalitza la cinta" des del menú esquerre i marqueu la casella corresponent a 'Desenvolupador' i feu clic a 'D'ACORD'.

Ara el "Pestanya de desenvolupador" és visible.

Mentre s’insereix el botó d’ordre, si continuem pressionant el botó Tecla ALT, llavors les vores del botó d'ordres seran juntes amb el límit de cel·les. Canvieu les propietats del botó d’ordres inserit mitjançant el menú contextual, que obtenim fent clic amb el botó dret del ratolí a "Botó d'ordres".

Finestra Propietats

Per escriure el codi VBA per al botó d’ordres, hem de seleccionar el botó d’ordres i triar "Mostra el codi" des del menú contextual.

Escriviu el codi de la següent manera:

Hem trucat "Shell" funció per escriure comanda per executar un programa (en el nostre cas és un símbol del sistema).

Hem utilitzat "ComSpec", que significa "Especificador d'ordres".

Ara sortiu del VBE i feu clic al botó d'ordres. Hem mostrat un símbol del sistema.

Exemple 2

Suposem que volem extreure noms de fitxers i detalls de la carpeta seleccionada de la manera següent.

Els passos per fer el mateix són:

Ompliu les cel·les B2: H9 de color taronja clar.

Creeu l'etiqueta amb el fitxer "Insereix" ordre al fitxer "Controls" grup al 'Desenvolupador'.

Creeu a continuació les etiquetes mostrades i editeu les propietats com subtítol, BackColor, Estil posterior, BorderStyle, Ombra

Creeu el quadre combinat de la següent manera mitjançant Quadre combinat (un dels controls ActiveX) disponible a Insereix ordre a Controls agrupa a Desenvolupador.

Després de crear el quadre combinat a Excel de la següent manera, podem canviar les propietats.

Afegirem codi per a la llista que es mostrarà al quadre combinat mitjançant el botó Mostra el codi al menú contextual.

És un codi per a "Seleccioneu la carpeta" Quadre combinat.

És un codi per a "Ordenar per" Quadre combinat.

És un codi per a "Selecciona la comanda" Quadre combinat.

Crearem un quadre de llista que conté tots els tipus de fitxers perquè l'usuari els pugui seleccionar per obtenir només aquest tipus de fitxers al resultat. Per fer el mateix, seleccioneu "Quadre de llista (control ActiveX)"De la"Insereix"Ordre a"Controls"Grup a"Desenvolupador”Pestanya.

Arrossegueu el quadre de llista com es mostra a continuació.

Canvieu les propietats del quadre de llista de la manera següent.

Per afegir els tipus de fitxers al quadre de llista, utilitzeu el codi següent.

Escriviu el codi a "Aquest llibre".

Codi:

 Private Sub Workbook_Open () Dim ArrFileType (25) As Variant ArrFileType (0) = "Full de treball de Microsoft Excel 97-2003 (.xls)" ArrFileType (1) = "Full de treball de Microsoft Office Excel (.xlsx)" ArrFileType (2) = " Full de treball habilitat per a macros de Microsoft Excel (.xlsm) "ArrFileType (3) =" Document Word 97-2003 (.doc) "ArrFileType (4) =" Document Word 2007-2010 (.docx) "ArrFileType (5) =" Text Document (.txt) "ArrFileType (6) =" Document Adobe Acrobat (.pdf) "ArrFileType (7) =" Carpeta comprimida (comprimida) (.Zip) "ArrFileType (8) =" Arxiu WinRAR (.rar) "ArrFileType (9) = "Configuració de la configuració (.ini)" ArrFileType (10) = "Fitxer GIF (.gif)" ArrFileType (11) = "Fitxer PNG (.png)" ArrFileType (12) = "Fitxer JPG (.jpg) "ArrFileType (13) =" So en format MP3 (.mp3) "ArrFileType (14) =" Fitxer M3U (.m3u) "ArrFileType (15) =" Format de text enriquit (.rtf) "ArrFileType (16) =" Vídeo MP4 (.mp4) "ArrFileType (17) =" Videoclip (.avi) "ArrFileType (18) =" Reproductor de Windows Media (.mkv) "ArrFileType (19) =" Fitxer SRT (.srt) "ArrFileType (20) = "Fitxer PHP (.php)" ArrFileType (21) = "Firefox HTML Document (.htm, .html)" ArrFileType (22) = "Document en full d'estil en cascada (.css)" ArrFileType (23) = "Fitxer de script JScript (.js)" ArrFileType (24) = "Document XML ( .xml) "ArrFileType (25) =" Fitxer per lots de Windows (.bat) "Sheet2.FileTypesListBox.List = ArrFileType End Sub 

Inseriu les caselles de selecció amb el mateix "Insereix"Ordre a"Controls"Grup a"Desenvolupador”I canvieu les propietats per inserir "Caselles de selecció" utilitzant "Propietats" disponible al mateix grup després de seleccionar els objectes.

Inseriu botons d'ordres mitjançant el fitxer "Insereix" disponible al mateix grup i canvieu les propietats com a subtítol i altres propietats també.

Hem format tota l'estructura. Ara hem d’escriure el codi.

Activeu el fitxer "Mode de disseny" i feu clic amb el botó dret aRecupereu tots els detalls dels fitxers"Per seleccionar el botó"Mostra el codi”Al menú contextual per afegir el codi del botó.

Primer declararem alguna variable al mòdul.

A continuació es mostra el codi afegit a un "Recupereu tots els detalls dels fitxers”Botó.

Codi:

 Private Sub FetchFilesBtnCommandButton_Click () iRow = 14 fPath = Environ ("HOMEPATH") & "\" & SelectTheFolderComboBox.Value If fPath "" Set Set FSO = New Scripting.FileSystemObject If FSO.FolderExists (fPathFer) False Then. GetFolder (fPath) If Sheet2.IncludingSubFoldersCheckBox.Value = True Then IsSubFolder = True Else IsSubFolder = False If SourceFolder.Files.Count = 0 Aleshores MsgBox "No hi ha fitxers en aquesta carpeta" & vbNewLine & vbNewLine & Prova la vostra carpeta Una vegada més !! ", vbInformation Exit Sub End If End If Call ClearResult If FetchAllTypesOfFilesCheckBox.Value = True Then Call ListFilesInFolder (SourceFolder, IsSubFolder) Call ResultSorting (xlAscending," C14 "," D14 "," E14 "InFolder ListXFold , IsSubFolder) Crida ResultSorting (xlAscending, "C14", "D14", "E14") Finalitza si FilesCountLabel.Caption = iRow - 14 Elg MsgBox "El camí seleccionat no existeix !!" & vbNewLine & vbNewLine & "Seleccioneu-ne un de correcte i torneu-ho a provar !!", vbInformation End If Else MsgBox "El camí de la carpeta no pot estar buit !!" & vbNewLine & vbNewLine & "", vbInformation End Si finalitza Sub 

Definiu el fitxer "ClearResult" funció al mòdul. Per inserir el mòdul, seleccioneu "Aquest llibre de treball" llavors "Insereix" i llavors ‘Mòdul” ’.

Escriviu el següent codi al mòdul.

Codi de ClearResult

Hi ha més subrutines com "ListFilesInFolder", "ListFilesInFolderXtn", "ResultSorting", definirem totes aquestes subrutines al mòdul.

"ListFilesInFolder"

Codi:

 Public Sub ListFilesInFolder (SourceFolder As Scripting.Folder, IncludeSubfolders As Boolean) A l'error Reprèn el següent per a cada element de fitxer de SourceFolder.Files 'Mostra les propietats del fitxer Cells (iRow, 2) .Formula = iRow - 13 cèl·lules (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). Seleccioneu Selection.Hyperlinks.Add Anchor: = Selecció, adreça: = _ FileItem.Path, TextToDisplay: = "Feu clic aquí per obrir" 'Cells (iRow, 8). = "= HYPERLINK (" "" & FileItem.Path & "" "," "" & "Feu clic aquí per obrir" & "" ")" iRow = iRow + 1 'número següent de la fila Fitxer següent Si s'inclouen subcarpetes per a cada subcarpeta A 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) a l'error Reprèn el següent dim FileArray As Variant FileArray = Get_File_Type_Array per a cada FileItem de SourceFolder.Files Truca ReturnFileType (FileItem.Type) 2) .Formula = iRow - 13 cel·les (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). Seleccioneu Selection.Hyperlinks.Add Anchor: = Selecció, adreça: = _ FileItem.Path, TextToDisplay : = "Feu clic aquí per obrir" Cel·les (iRow, 8) .Formula = "= HYPERLINK (" "" & FileItem.Path & "" "," "" & "Feu clic aquí per obrir" & "" ")" iRow = iRow + 1 'següent número de fila Finalitza si següent FileItem si Inclou subcarpetes Llavors per a cada subcarpeta de SourceFolder.SubFolders ListFilesInFolderXtn Subcarpeta, True Next Subcarpeta End If Set FileItem = No hi ha res definit a la carpeta Source = Nothing Set FSO = Nothing End Sub 

"ResultSorting"

 Sub ResultSorting (xlSortOrder As String, sKey1 As String, sKey2 As String, sKey3 As String) Range ("C13"). Seleccioneu Range (Selection, Selection.End (xlDown)). Seleccioneu Range (Selection, Selection.End (xlToRight) ). Seleccioneu Selection.Sort Key1: = Range (sKey1), Order1: = xlSortOrder, Key2: = Range (sKey2 _), Order2: = xlAscending, Key3: = Range (sKey3), Order3: = xlSortOrder, Header _: = xlGuess, OrderCustom: = 1, MatchCase: = False, Orientation: = xlTopToBottom _, DataOption1: = xlSortNormal, DataOption2: = xlSortNormal, DataOption3: = _ xlSortNormal Range ("B14"). Seleccioneu End Sub 

En "ListFilesInFolderXtn" subrutina, hem anomenat una funció anomenada "ReturnFileType" i "GetFileTypeArray", hem de definir les funcions del mateix mòdul.

"ReturnFileType"

Codi:

 Funció pública ReturnFileType (fileType com a cadena, FileArray com a variant) Com a dimensió booleana com a enter IsFileTypeExists = Fals Per a i = 1 a UBound (FileArray) + 1 Si FileArray (i - 1) = fileType, llavors IsFileTypeExists = Sortida veritable per a altres tipus IsFileType Funció de finalització falsa si finalització següent 

"GetFileTypeArray"

Codi:

Funció pública Get_File_Type_Array () Com a variant Variant i, j, TotalSelected com a enter Dim Dim arrList () Com a cadena TotalSelected = 0 Per a i = 0 a Sheet2.FileTypesListBox.ListCount - 1 Si 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 Funció final 

Tenim un botó d’ordre subtitulat com "Exporta a fitxer Excel", hem d’escriure el codi d’aquest botó de la següent manera:

Al mòdul, definiu la subrutina anomenada "Exporta_a_excel".

Codi:

 Sub Export_to_excel () On Error GoTo error 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"). Seleccioneu Range ((B13)). Selection, Selection.End (xlDown)). Seleccioneu Range (Selection, Selection.End (xlToRight)). Seleccioneu Selection.Copy xlApp.Visible = True xlWB.Activate xlWB.Sheets ("Sheet1"). Select xlWB.Sheets (" Full1 "). Interval (" B2 "). Enganxa Enganxa especial: = xlPasteValues ​​xlWB.Sheets (" Sheet1 "). Cells.Select xlWB.Sheets (" Sheet1 "). Cells.EntireColumn.AutoFit xlWB.Sheets (" Sheet1 ") .Range ("B2"). Seleccioneu Exit Sub err: MsgBox ("S'ha produït un error en exportar. Torneu-ho a provar") Finalitza el sub 

Tenim un botó d'ordre més titulat com a "Exporta a fitxer de text". Escriurem el codi del botó d’ordres de la següent manera:

En aquest codi, podem veure que tenim un formulari d’usuari que hem de dissenyar seguint els passos següents:

Feu clic dret a "Full2 (exemple2)" full i tria "Insereix" i llavors "UserForm" des del menú.

Dissenyeu el UserForm mitjançant eines de la caixa d'eines.

Hem utilitzat "Etiquetes", 'Quadre combinat', 'Caixa de text' i "Botons d'ordres" per al Formulari d’usuari i han canviat el títol i el nom de tots els components.

Per al primer botó d'ordres (D'acord), hem d’escriure el codi de la següent manera:

Codi:

 Private Sub CommandButton1_Click () Dim iSeperator As String If ComboBox1.Value = "Other" Then iSeperator = TextBox1.Value Else iSeperator = ComboBox1.Value End If If iSeperator = "" Aleshores si MsgBox ("Hola no heu seleccionat cap delimitador". & vbNewLine & vbNewLine & _ "Serà molt difícil llegir el fitxer de text, sense delimitador específic", vbSíNo) = vbSí Llavors truqueu al fitxer de text (iSeperator) Sortir més Subfinit Si seleccioneu un cas ComboBox1.ListIndex Cas 0: iSeperator = " , "Cas 1: iSeperator =" | " Cas 2: iSeperator = "vbTab" Cas 3: iSeperator = ";" Finalitza Selecciona fitxer de text de trucada (iSeperator) Descarrega'm Finalitza si finalitza Sub 

Hem trucat "Fitxer de text" funció a la subrutina per al botó d'ordre, per això hem de definir "Fitxer de text" funció al mòdul.

Codi:

 Subfitxer de text (iSeperator As String) 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" Per a la sortida com a # 1 Imprimir # 1 "," Tancar # 1 Obriu ThisWorkbook.Path & "\ File1.txt" Per a Afegir com a # 1 Per a iRow = 13 a TotalRowNumber iLine = "" Per a iCol = 2 a 7 iLine = iLine & iSeperator & Cells (iRow, iCol). Valor Següent Imprimeix # 1, iLine Següent Tanca # 1 Altres Obriu aquest llibre de treball.Path & "\ File1.txt" Per a la sortida com a # 1 Imprimeix # 1 , "" Tanca # 1 Obre ThisWorkbook.Path & "\ File1.txt" Per a Afegir com a # 1 Per a iRow = 13 a TotalRowNumber iLine = "" Per a iCol = 2 a 7 iLine = iLine & vbTab & Cells (iRow, iCol) .Valueu Imprimeix # 1, iLine Següent Tanca # 1 Finalitza si f = Shell ("C: \ WINDOWS \ notepad.exe" & ThisWorkbook.Path & "\ File1.txt", vbMaximizedFocus) MsgBox "El vostre fitxer està desat a" & ThisWorkbook.Path & "\ File1.txt" End Sub 

Per a botó d'ordre 2 (Cancel·lar), hem d’escriure el següent codi. Feu doble clic al botó de cancel·lació per escriure el codi.

Per al quadre combinat per seleccionar un especificador, escriviu el següent codi.

Per al UserForm, escriviu el següent codi.

Per al "Recupera tot tipus de fitxers" casella de selecció, escriviu el següent codi.

Per al "ListBox" per als tipus de fitxers, escriviu el següent codi.

Per a "SelectTheOrder" quadre combinat, escriviu el següent codi.

Codi:

 Private Sub SelectTheOrderComboBox_Change () Seleccioneu majúscules (SelectTheOrderComboBox.Value) Majúscules "Ascendents" si SortByComboBox.Value = "Nom del fitxer" Llavors truqueu ResultSorting (xlAscending, "C14", "E14", "G14") Finalitza si SortByComboBox. "Tipus de fitxer" Llavors truqueu ResultSorting (xlAscending, "F14", "E14", "C14") Finalitza si SortByComboBox.Value = "Mida de fitxer" Llavors truqueu ResultSorting (xlAscending, "E14", "C14", "G14" ) Finalitza If If SortByComboBox.Value = "Última modificació" Llavors truca ResultSorting (xlAscending, "G14", "C14", "E14") Finalitza si majúscula "Descendent" Si SortByComboBox.Value = "Nom del fitxer" Llavors crida ResultSorting , "C14", "E14", "G14") Finalitza If If SortByComboBox.Value = "Tipus de fitxer" Llavors truca ResultSorting (xlDescending, "F14", "E14", "C14") Finalitza If If SortByComboBox.Value = " Mida del fitxer "Llavors truqueu ResultSorting (xlDescending," E14 "," C14 "," G14 ") Finalitza si SortByComboBox.Value =" Última modificació "Llavors truqueu ResultSorting (xlDescending," G14 "," C14 "," E14 ") Finalitza si el cas per defecte surt de Finalitza sub Selecciona Finalitza sub 

Per a 'Ordenar per' quadre combinat, escriurem el següent codi.

Codi:

 Private Sub SortByComboBox_Change () Seleccioneu majúscules (SelectTheOrderComboBox.Value) Majúscules "Ascendents" si SortByComboBox.Value = "Nom del fitxer" Llavors truqueu ResultSorting (xlAscending, "C14", "E14", "G14") Finalitza si SortByComboBox.V "Tipus de fitxer" Llavors truqueu ResultSorting (xlAscending, "F14", "E14", "C14") Finalitza si SortByComboBox.Value = "Mida de fitxer" Llavors truqueu ResultSorting (xlAscending, "E14", "C14", "G14" ) Finalitza If If SortByComboBox.Value = "Última modificació" Llavors truca ResultSorting (xlAscending, "G14", "C14", "E14") Finalitza si majúscula "Descendent" Si SortByComboBox.Value = "Nom del fitxer" Llavors truca ResultSorting (xlDescending , "C14", "E14", "G14") Finalitza If If SortByComboBox.Value = "Tipus de fitxer" Llavors truca ResultSorting (xlDescending, "F14", "E14", "C14") Finalitza If If SortByComboBox.Value = " Mida del fitxer "Llavors truqueu ResultSorting (xlDescending," E14 "," C14 "," G14 ") Finalitza si SortByComboBox.Value =" Última modificació "Llavors truqueu ResultSorting (xlDescending," G14 "," C14 "," E14 ") Finalitza si el cas per defecte surt de Subfin Selecciona Final sub 

Ara hem escrit tot el codi. Ara podem seleccionar la carpeta i el tipus de fitxer desitjats i esbrinar la llista de fitxers que podem ordenar per "Nom del fitxer", "Tipus de fitxer", "Mida del fitxer" o "Última modificació" i podem exportar la llista a Excel o fitxer de text.

Coses que cal recordar

Si el valor, per al qual especifiquem 'Envstring' L'argument no es troba a la taula de cadenes d'entorn, la funció ENVIRON retorna la cadena de longitud zero.