Bonjour
Vous trouverez ci dessous quelques exemples d'informations sur le PC , le systeme d'exploitation et les autres applications , depuis Excel
cela n'a plus grand chose à voir avec notre tableur préféré , mais c'est juste pour marquer mon 300 ieme message sur le nouveau forum XLD...;o)
( testé avec Excel2002 & WinXP)
Afficher la boite de dialogue Windows 'Arreter l'ordinateur'
Vérifier s'il y a un CD dans le lecteur
Afficher le Label d'un CDRom
Retour sur le bureau , Minimiser toutes les applications ouvertes
Maximaliser toutes les applications ouvertes
Afficher quelques boites de dialogue Windows
Afficher la fenetre Observateur d'evenements
Ouvrir l'explorateur Windows sur un répertoire précis
positionner le curseur de la souris à un endroit précis sur l'écran
Utiliser l'API GetCursorPos pour récupérer la position du curseur de la souris
Le lien sur le forum XLD
Lien supprimé
Afficher la vitesse paramétrée pour le double clic de la souris
Afficher le nom du PC
Le lien sur le forum XLD
Lien supprimé
Récupérer quelques informations sur votre PC
le nom du PC
le systeme utilisé
les noms et types de lecteurs ( avec le numéro de serie et l'espace libre pour les disques durs )
la résolution de l'écran
la mémoire physique totale et libre
la liste des imprimantes installées et l'imprimante active
la version d'Excel et de VBE
les processeurs
l'utilisateur
l'adresse IP
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Afficher des informations sur un excecutable
le nom de l'éditeur
la description du programme
la version du fichier
le nom interne
le copyright
le nom de l'application
le nom du produit
la version du produit
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Afficher la version d'une application
Changer l'image de fond d'écran du bureau , depuis Excel
Afficher la boite de dialogue pour régler le son du PC
Controler la présence d'une carte son sur le PC
XLD Music Player , un lecteur de CD audio pour Excel , à partir de la version 2000
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Afficher la durée des fichiers WMV , AVI , WAV , MP3
Le lien sur le forum XLD
Lien supprimé
Enregistrer dans un fichier texte les propriétés des périphériques USB
Afficher la boite de dialogue des options régionales
Afficher la boite de dialogue 'propriétés de la souris'
Afficher la boite de dialogue 'propriétés d'affichage'
Récuperer le code couleur à l'emplacement du curseur de la souris
Une des macros du classeur permet aussi de récupérer la couleur de fond du bureau
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Fermer Windows et redémarrer le PC
Le lien sur le forum XLD (une démo par EMG)
Lien supprimé
Le lien sur le forum XLD (une démo par Veriland)
Lien supprimé
Le lien sur le forum XLD (des infos de @+Thierry pour Windows2000)
Lien supprimé
Creer un raccourci sur le bureau , pour le classeur contenant cette macro
Vider le répertoire des documents récemment utilisés
Capturer les images perçues par une webCam
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Lister des informations sur les raccourcis du bureau
Boucler sur les raccourcis du bureau et le lancer si le nom est retrouvé
(ACDSee.exe dans l'exemple )
Afficher une image avec ' l'apercu des images et des telecopies Windows '
Quatre méthodes pour ouvrir d'autres types de fichiers depuis Excel
Lire un fichier directement avec l'application qui l'ouvre par défaut
Fermer une application , Exemple notePad
Lire un texte saisi dans un Userform
( utilisation de la librairie Microsoft Speech)
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Il est aussi possible de modifier le ton lors de la diction
en ajoutant à la suite du texte : un espace et 2 points d'exclamations ' !!'
en ajoutant à la suite du texte : un espace et 2 points d'interrogation ' ??'
Lister le nom des fichiers contenus dans un Zip
Le lien sur le forum XLD
Lien supprimé
La source VB
http://www.vbfrance.com/code.aspx?id=17052
générer des fichiers Flash depuis Excel
(necessite d'installer prealablement la DLL Mingx )
http://www.swfkit.com/mingx/download.html
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
bon apres midi
MichelXld
Vous trouverez ci dessous quelques exemples d'informations sur le PC , le systeme d'exploitation et les autres applications , depuis Excel
cela n'a plus grand chose à voir avec notre tableur préféré , mais c'est juste pour marquer mon 300 ieme message sur le nouveau forum XLD...;o)
( testé avec Excel2002 & WinXP)
Afficher la boite de dialogue Windows 'Arreter l'ordinateur'
Code:
Public Declare Function SHShutDownDialog Lib 'shell32' Alias '#60' _
(Byval Yourguess As Long) As Long
'testé avec WinXP
Sub afficherFenetreArreterOrdinateur()
SHShutDownDialog 1
End Sub
Vérifier s'il y a un CD dans le lecteur
Code:
Sub testPresenceCD()
On Error goTo Fin
Dir 'D:\\.' 'adapter nom Lecteur
Msgbox 'il y a un CD dans lecteur D .'
Exit Sub
Fin:
If Err = 52 Then Msgbox 'il n'y a Pas de CD dans lecteur D .'
End Sub
Afficher le Label d'un CDRom
Code:
Sub afficherLabelCDRom()
Dim Lecteur As String
Dim Fs As Object, D As Object
Lecteur = 'D:\\' 'adapter la lettre du lecteur
Set Fs = createObject('Scripting.fileSystemObject')
If Fs.driveExists(Lecteur) = True Then
Set D = Fs.getDrive(Lecteur)
If D.driveType = 4 Then '4='CDROM'
Set D = Fs.getDrive(Fs.getDriveName(Lecteur))
If (D.isReady) Then msgBox D.volumeName
End If
End If
End Sub
Retour sur le bureau , Minimiser toutes les applications ouvertes
Code:
Sub minimizerToutesLesApplications()
Dim WSHshell As Object, Shell As Object
Set WSHshell = createObject('WScript.Shell')
Set Shell = createObject('Shell.Application')
Shell.minimizeAll
End Sub
Maximaliser toutes les applications ouvertes
Code:
Sub maximaliserToutesLesApplications()
Dim WSHshell As Object, Shell As Object
Set WSHshell = createObject('WScript.Shell')
Set Shell = createObject('Shell.Application')
Shell.undoMinimizeAll
End Sub
Afficher quelques boites de dialogue Windows
Code:
Sub afficherFenetresWinows()
'necessite d'activer reference Microsoft Shell Controls and Automation
Dim objShell As Shell
Set objShell = New Shell
objShell.controlPanelItem ('mmsys.cpl') 'Proprietes Sons Et Peripheriques Audio
'objShell.controlPanelItem ('desk.cpl')'fenetre Proprietes Affichage Windows
'objShell.controlPanelItem ('appwiz.cpl') 'fenetre Proprietes Sons Et Peripheriques Audio
'objShell.controlPanelItem ('timedate.cpl') 'fenetre Proprietes de dates et heures
'objShell.controlPanelItem ('sysdm.cpl') 'fenetre Proprietes systeme
'objShell.controlPanelItem ('main.cpl') 'fenetre Proprietes de la souris
'objShell.controlPanelItem ('intl.cpl') 'fenetre options regionales et linguistiques
'objShell.fileRun 'boite de dialogue Execution
End Sub
Afficher la fenetre Observateur d'evenements
Code:
Sub observateurEvenements()
Dim objShell As Object
Dim Machine As String
Dim RetVal As Long
Machine = '.'
Set objShell = CreateObject('wscript.shell')
RetVal = objShell.Run('eventvwr.exe ' & Machine & ' C:\\Windows\\system32', 1, True)
End Sub
Ouvrir l'explorateur Windows sur un répertoire précis
Code:
Sub ouvrirExplorateurWindows()
'necessite d'activer reference Microsoft Shell Controls and Automation
Dim objShell As Shell
Set objShell = New Shell
objShell.Explore ('C:\\Documents and Settings\\michel\\dossier\\general\\excel')
End Sub
positionner le curseur de la souris à un endroit précis sur l'écran
Code:
Declare Function SetCursorPos Lib 'user32' _
(byVal x As Long, byVal y As Long) As Long
Sub positionCurseur()
SetCursorPos 100, 200
End Sub
Utiliser l'API GetCursorPos pour récupérer la position du curseur de la souris
Le lien sur le forum XLD
Lien supprimé
Afficher la vitesse paramétrée pour le double clic de la souris
Code:
Declare Function GetDoubleClickTime& Lib 'user32' ()
Sub tempsDoubleClic()
MsgBox GetDoubleClickTime & ' millisecondes .'
End Sub
Afficher le nom du PC
Le lien sur le forum XLD
Lien supprimé
Récupérer quelques informations sur votre PC
le nom du PC
le systeme utilisé
les noms et types de lecteurs ( avec le numéro de serie et l'espace libre pour les disques durs )
la résolution de l'écran
la mémoire physique totale et libre
la liste des imprimantes installées et l'imprimante active
la version d'Excel et de VBE
les processeurs
l'utilisateur
l'adresse IP
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Afficher des informations sur un excecutable
le nom de l'éditeur
la description du programme
la version du fichier
le nom interne
le copyright
le nom de l'application
le nom du produit
la version du produit
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Afficher la version d'une application
Code:
Sub versionApplication()
Dim Fso As Object
Set Fso = createObject('Scripting.fileSystemObject')
msgBox Fso.getFileVersion('C:\\WINDOWS\\system32\\calc.exe')
End Sub
Changer l'image de fond d'écran du bureau , depuis Excel
Code:
Private Declare Function SystemParametersInfo Lib _
'user32' Alias 'SystemParametersInfoA' _
(byVal uAction As Long, byVal uParam As Long, byVal lpvParam As Any, _
byVal fuWinIni As Long) As Long
Private Const SPI_SETDESKWALLPAPER = 20
Sub changerFondEcran()
'testé avec Excel2002 et WinXP
Dim retVal As Long
Dim Fichier As String
Fichier = 'C:\\WINDOWS\\Plume.bmp' 'adapter le chemin du fichier
retVal = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Fichier, 0)
End Sub
Afficher la boite de dialogue pour régler le son du PC
Code:
Sub reglageSonPC()
Dim retVal As Long
retVal = Shell('sndvol32 /t')
End Sub
Controler la présence d'une carte son sur le PC
Code:
Declare Function waveOutGetNumDevs Lib 'winmm' () As Long
Sub controlePresenceCarteSon()
Dim i As Long
i = waveOutGetNumDevs()
If i > 0 Then msgBox 'Il y a une carte son sur votre poste . '
End Sub
XLD Music Player , un lecteur de CD audio pour Excel , à partir de la version 2000
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Afficher la durée des fichiers WMV , AVI , WAV , MP3
Le lien sur le forum XLD
Lien supprimé
Enregistrer dans un fichier texte les propriétés des périphériques USB
Code:
Sub listerProprietes_peripheriqueUsb()
'adapté de [url]http://www.vbcode.com/[/url]
'enregistre les proprietes des peripheriques USB
'dans un fichier Texte ( dans le meme repertoire que ce classeur )
'testé avec WinXP et Excel2002
Dim objWMIService As Object, objItem As Object, colItems As Object
Dim nomPC As String
Dim Fichier As String
nomPC = '.'
Fichier = thisWorkbook.Path & '\\Propriétés_USB.Txt'
Open Fichier For Output As #1
Set objWMIService = getObject('winmgmts:\\\\' & nomPC & '\\root\\cimv2')
Set colItems = objWMIService.execQuery('Select * from Win32_USBController', , 48)
For Each objItem In colItems
Print #1, ''
Print #1, 'Availability: ' & objItem.Availability
Print #1, 'Caption: ' & objItem.Caption
Print #1, 'configManagerErrorCode: ' & objItem.configManagerErrorCode
Print #1, 'configManagerUserConfig: ' & objItem.configManagerUserConfig
Print #1, 'creationClassName: ' & objItem.creationClassName
Print #1, 'Description: ' & objItem.Description
Print #1, 'DeviceID: ' & objItem.DeviceID
Print #1, 'errorCleared: ' & objItem.errorCleared
Print #1, 'errorDescription: ' & objItem.errorDescription
Print #1, 'installDate: ' & objItem.installDate
Print #1, 'lastErrorCode: ' & objItem.lastErrorCode
Print #1, 'Manufacturer: ' & objItem.Manufacturer
Print #1, 'maxNumberControlled: ' & objItem.maxNumberControlled
Print #1, 'Name: ' & objItem.Name
Print #1, 'PNPDeviceID: ' & objItem.PNPDeviceID
Print #1, 'powerManagementCapabilities: ' & objItem.powerManagementCapabilities
Print #1, 'powerManagementSupported: ' & objItem.powerManagementSupported
Print #1, 'protocolSupported: ' & objItem.protocolSupported
Print #1, 'Status: ' & objItem.Status
Print #1, 'statusInfo: ' & objItem.statusInfo
Print #1, 'systemCreationClassName: ' & objItem.systemCreationClassName
Print #1, 'systemName: ' & objItem.systemName
Print #1, 'timeOfLastReset: ' & objItem.timeOfLastReset
Print #1, ''
Print #1, ''
Next
Close
End Sub
Afficher la boite de dialogue des options régionales
Code:
Sub optionsRegionales()
Dim X As Double
X = Shell('rundll32.exe shell32.dll,Control_RunDLL intl.cpl')
End Sub
Afficher la boite de dialogue 'propriétés de la souris'
Code:
Sub proprietesSouris()
Call Shell('rundll32.exe shell32.dll,Control_RunDLL main.cpl @0', vbNormalFocus)
End Sub
Afficher la boite de dialogue 'propriétés d'affichage'
Code:
Sub propietesAffichage()
Call Shell('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0', vbNormalFocus)
End Sub
Récuperer le code couleur à l'emplacement du curseur de la souris
Une des macros du classeur permet aussi de récupérer la couleur de fond du bureau
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Fermer Windows et redémarrer le PC
Le lien sur le forum XLD (une démo par EMG)
Lien supprimé
Le lien sur le forum XLD (une démo par Veriland)
Lien supprimé
Le lien sur le forum XLD (des infos de @+Thierry pour Windows2000)
Lien supprimé
Creer un raccourci sur le bureau , pour le classeur contenant cette macro
Code:
Sub creerRaccourciBureau()
'necessite d'activer la reference Windows Script Host Object Model
Dim xShell As IWshRuntimeLibrary.wshShell
Dim Raccourci As IWshRuntimeLibrary.wshShortcut
Dim dirBureau As String
Set xShell = createObject('WScript.Shell')
dirBureau = xShell.specialFolders('Desktop')
Set Raccourci = xShell.createShortcut(dirBureau & '\\monFichier.lnk')
Raccourci.targetPath = thisWorkbook.fullName
Raccourci.windowStyle = 1
Raccourci.iconLocation = 'C:\\dating.ico' 'attribuer un icône
Raccourci.Save
End Sub
Vider le répertoire des documents récemment utilisés
Code:
Declare Sub SHAddToRecentDocs Lib 'shell32.dll' (byVal uFlags As Long, _
byVal pv As String)
Sub viderMenuDocumentsRecents()
'C:\\Documents and Settings\\mimi\\Recent
SHAddToRecentDocs 2, vbNullString
End Sub
Capturer les images perçues par une webCam
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Lister des informations sur les raccourcis du bureau
Code:
Sub informationsRaccourcisBureau()
'http://www.excelforum.com/showthread.php?p=932077&posted=1#post932077
'michelxld le 01.04.2005
'
'activate Microsoft Shell Controls and Automation reference
'activate Microsoft Scripting Runtime reference
'
'test with excel2002 & WinXp
Const Cible = &H10 'Desktop
'Const Cible = &H6 'Favorites
'
Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim colItems As Shell32.FolderItems
Dim objItem As Shell32.FolderItem
Dim i As Integer
Dim Fso As Scripting.FileSystemObject
Dim FileItem As Scripting.File
Set objShell = CreateObject('Shell.Application')
Set objFolder = objShell.NameSpace(Cible)
Set colItems = objFolder.Items
Set Fso = CreateObject('Scripting.FileSystemObject')
For Each objItem In colItems
If objItem.IsLink Then
i = i + 1
Cells(i, 1) = objItem.Path
Cells(i, 2) = objItem.GetLink.Path
Cells(i, 3) = objFolder.GetDetailsOf(objItem, 14)
If Fso.FileExists(objItem.GetLink.Path) Then
Set FileItem = Fso.GetFile(objItem.GetLink.Path)
Cells(i, 4) = FileItem.Type
Cells(i, 5) = objItem.Name
End If
End If
Next
End Sub
Boucler sur les raccourcis du bureau et le lancer si le nom est retrouvé
(ACDSee.exe dans l'exemple )
Code:
Sub lancerRaccourciBureau()
'michelxld le 15.04.2005
'necessite d'activer la reference Microsoft Shell Controls and Automation
Const Cible = &H10 'Desktop
Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim colItems As Shell32.FolderItems
Dim objItem As Shell32.FolderItem
Dim Longueur As Integer, i As Integer
Set objShell = CreateObject('Shell.Application')
Set objFolder = objShell.NameSpace(Cible)
Set colItems = objFolder.Items
For Each objItem In colItems
If objItem.IsLink Then
Longueur = Len(objItem.GetLink.Path)
i = Longueur
While Mid(objItem.GetLink.Path, i, 1) <> '\\'
i = i - 1
Wend
If Mid(objItem.GetLink.Path, i + 1, Longueur - i) = 'ACDSee.exe' _
Then objItem.InvokeVerb
End If
Next
End Sub
Afficher une image avec ' l'apercu des images et des telecopies Windows '
Code:
Declare Function ShellExecute Lib 'shell32.dll' Alias 'ShellExecuteA' _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub afficherImage_ApercuWindows()
'http://www.excel-downloads.com/html/French/forum/messages/1_127361_127361.htm
'testé avec Excel2002 et WinXP
'force l'affichage de l'image avec 'L'aperçu des images et des télécopies windows'.
Dim Img As String
Img = 'C:\\Documents and Settings\\michel\\dossier\\general\\general\\LeChat.bmp' 'adapter le chemin
ShellExecute 0, 'open', 'rundll32.exe', 'C:\\WINDOWS\\System32\\shimgvw.dll,ImageView_Fullscreen ' & Img, 0, 1
End Sub
Quatre méthodes pour ouvrir d'autres types de fichiers depuis Excel
Code:
Sub lancerPPT()
Dim Cible
Cible = Shell('POWERPNT.EXE ''C:\\Mes documents\\flux prod maint compta.ppt''', 1)
End Sub
Code:
Sub ouvrirWord()
thisWorkbook.followHyperlink 'C:\\Documents and Settings\\michel\\test.doc'
End Sub
Code:
Sub ouvertureAppli04()
Dim Obj As Object
Set Obj = createObject('WScript.Shell')
Obj.Run 'calc.exe ', 1, True'exemple calculatrice
End Sub
Code:
Declare Function WinExec Lib 'kernel32' (ByVal lpCmdLine As String, _
ByVal nCmdShow As Long) As Long
Sub OuvertureCalc()
WinExec 'calc', 10
End Sub
Lire un fichier directement avec l'application qui l'ouvre par défaut
Code:
Declare Function ShellExecute Lib 'shell32.dll' Alias 'ShellExecuteA' _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub ouvrirFichier()
'permet d'ouvrir un document avec l'executable défini par defaut
Dim leFichier As String
leFichier = 'C:\\Documents and Settings\\michel\\monDocumentOOo.sxw'
ShellExecute 0, 'open', leFichier, '', '', vbNormalFocus
End Sub
Fermer une application , Exemple notePad
Code:
Sub fermerUneApplication()
'testé avec Excel2002 et WinXP
Dim objProcess As Object, colProcessList As Object, objWMIService As Object
Dim strComputer As String
strComputer = '.'
Set objWMIService = getObject('winmgmts:' _
& '{impersonationLevel=impersonate}!\\\\' & strComputer & '\\root\\cimv2')
Set colProcessList = objWMIService.execQuery _
('Select * from Win32_Process Where Name = 'Notepad.exe'')
For Each objProcess In colProcessList
objProcess.Terminate
Next
End Sub
Lire un texte saisi dans un Userform
( utilisation de la librairie Microsoft Speech)
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
Il est aussi possible de modifier le ton lors de la diction
en ajoutant à la suite du texte : un espace et 2 points d'exclamations ' !!'
en ajoutant à la suite du texte : un espace et 2 points d'interrogation ' ??'
Lister le nom des fichiers contenus dans un Zip
Le lien sur le forum XLD
Lien supprimé
La source VB
http://www.vbfrance.com/code.aspx?id=17052
générer des fichiers Flash depuis Excel
(necessite d'installer prealablement la DLL Mingx )
http://www.swfkit.com/mingx/download.html
Le lien sur le forum XLD
Lien supprimé
Le fichier zippé
Lien supprimé
bon apres midi
MichelXld