Page Accueil FAQ MPFE Liens Format de nombres Téléchargement Applications Combinaisons


* * *
  SOMMAIRE
  La FAQ
  VBAXL
  BASIC
  ASTUCES
Exemples
  Boucles
  Cellules
  Cellules 2
  Divers
  Erreurs
  Fichiers
  Feuilles
  Impression
  Médias
  Messages
  Outils
  Spéciales
  Tests
  Le Web
  Userform
  XL et Word
  XL Clipboard
  XL 2007
  XL et XML
 
  Macro :o)
  Réactions
  Livre d'Or

 

titre


Les Spéciales

Formate une disquette

Sub FormatageDSK()
ValRetour = Shell("C:\WINDOWS\RUNDLL32.EXE shell32,SHFormatDrive", 1)
End Sub

Change le label d'une disquette

Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" _
(ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long

Sub NommeDSK()
retval = SetVolumeLabel("a:\", "MaDisquette")

'pour supprimer le label
'retval = SetVolumeLabel("a:\", vbNullString)
End Sub

Lance un test d'imprimante

Sub LanceTestImp()
ValRetour = Shell("C:\WINDOWS\RUNDLL32.EXE msprint2.dll,RUNDLL_PrintTestPage", 1)
End Sub

Liste les fichiers excel de c:\ dans le fichier dirxls.xls

'liste les fichiers excel de c:\ Par repertoire Nb de fichiers et taille totale
'à la façon du dir de DOS

Sub Dirxls()
Shell "command.com /c dir c:\*.xls /W/O/S >C:\ajeter\dirxls.xls", vbHide
End Sub

'liste les fichiers excel de c:\ dans une simple liste

Sub Dirxls2()
Shell "command.com /c dir c:\*.xls /s/b >C:\ajeter\dirxls.xls", vbHide
End Sub

Imprime la liste de vos favoris en exécutant un fichier BAT (commande DOS)

Sub ImpFichier()
Shell "C:\outil\printfav.bat"
End Sub

'listing de printfav.bat
'à copier dans le bloc-note et à enregistrer sous le nom de "printfav.bat" dans le répertoire C:\outil

@ ECHO OFF
ECHO Programme d'impression de la liste des Favoris
ECHO.
ECHO.
@ECHO ********* QUE SOUHAITEZ-VOUS FAIRE ? ***********
@ECHO. @ECHO A: Impression de la liste des favoris.
@ECHO B: Quitter le programme.
@ECHO.
@ECHO.
CHOICE /C:AB Choisir A (Impression), B (Annuler)
ECHO.
IF ERRORLEVEL 2 GOTO FIN
IF ERRORLEVEL 1 GOTO imp

: imp
dir "c:\windows\favoris" /s /b /l > c:\favori.wri
write c:\favori.wri /p
del c:\favori.wri /p
GOTO FIN
: FIN
ECHO.
@ECHO Terminer
@ECHO.
@ECHO "Cliquer sur la petite croix pour fermer."

Pour fermer la fenêtre DOS automatiquement

il faut ajouter COMMAND.COM /C à la commande SHELL

Sub Exemple()
Shell ("command.com /C C:\outil\printfav.bat")
End Sub

Lance Explorer en version minimale

Sub LanceExplore()
ValRetour = Shell("C:\WINDOWS\RUNDLL32.EXE shell,shellexecute", 1)
End Sub

Lance Explorer et ouvre un dossier

Sub ExplorerDossier()
Shell "C:\WINDOWS\EXPLORER.EXE /n,/e,D:\FichXls", vbMaximizedFocus
End Sub

Masque et affiche la barre de tâche windows(97 - XP)

Option Explicit

Dim handleW1 As Long

Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function SetWindowPos Lib "user32" _
(ByVal handleW1 As Long, _
ByVal handleW1InsertWhere As Long, ByVal w As Long, _
ByVal x As Long, ByVal y As Long, ByVal z As Long, _
ByVal wFlags As Long) As Long

Const TOGGLE_HIDEWINDOW = &H80
Const TOGGLE_UNHIDEWINDOW = &H40

Sub masque()
handleW1 = FindWindowA("Shell_traywnd", "")
Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_HIDEWINDOW)
End Sub

Sub affiche()
Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_UNHIDEWINDOW)
End Sub

Ferme windows

Sub WinExit() 'marche bien sous XP
With CreateObject("Shell.Application")
.ShutdownWindows
End With
End Sub

Sub ExitWindows9598()
ValRetour = Shell("C:\WINDOWS\rundll32.exe user.exe,exitwindows")
End Sub

Sub RedemarWindows98()
ValRetour = Shell("C:\WINDOWS\Rundll32.exe shell32,SHExitWindowsEx")
End Sub

Ouvre Internet Explorer

Sub LanceIE()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://dj.joss.free.fr"
IE.AddressBar = True
IE.MenuBar = True
IE.Toolbar = True
IE.Width = 800
IE.Height = 600
IE.Resizable = True
IE.Visible = True
Set IE = Nothing
End Sub

Comment lancer la calculette et l'avoir toujours à l'écran ?

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_SHOWWINDOW = &H40

Dim hWndCalc As Long
Sub Lance()
Dim lResult As Long
On Error GoTo erreur
lResult = Shell("calc.exe")
hWndCalc = FindWindow("SciCalc", "Calculatrice")
lResult = SetWindowPos(hWndCalc, HWND_TOPMOST, 0&, 0&, 0&, 0&, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
Exit Sub
erreur:
If Err = 53 Then MsgBox "La calculatrice n'a pas été installée ! "", vbExclamation"
On Error Resume Next
End Sub

 

[top]

 

     
 ©Conception et Graphisme. Daniel Josserand . Novembre 2000