Les meilleurs sources pour Excel
Les meilleurs sources pour ExcelConsultez toutes les FAQ
Nombre d'auteurs : 10, nombre de questions : 65, dernière mise à jour : 26 mars 2022
Sommaire→Interface
Un lecteur CD Audio dans Excel.
Les procédures ont été testées avec XL2002,XL2003 et WinXP.
Tutoriel: Créer un lecteur de CD audio dans Excel.
Téléchargement : Exemple
Un exemple de procédure pour retrouver les équivalences de couleur Hex-Long-RGB , en VBA Excel.
Testé sous XL97,XL2000,XL2002
Tutoriel: Les couleurs en VBA Excel: Les équivalences Hex-Long-RGB.
Téléchargement : Exemple
Initiation à l'utilisation de la bibliothèque MSXML de Microsoft.
Testé sous XL2002/W2002..
Tutoriel: Visual Basic 6.0 et le format XML.
Téléchargement : Exemple
Cet outil permet de créer des MsgBox étendues affichant du texte formaté (RTF).
Elles sont auto-refermables et on peut également modifier le texte des boutons.
Le tutoriel: OFFICE : Fenêtres de message étendues.
Téléchargement : Exemple
L'objet Screen n'existant pas en VBA, on peut retrouver ces valeurs en utilisant les fonctions de l'API Win32 :
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const HWND_DESKTOP As Long = 0
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Function TwipsPerPixelX() As Single
Dim lngDC As Long
lngDC = GetDC(HWND_DESKTOP)
TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
ReleaseDC HWND_DESKTOP, lngDC
End Function
Function TwipsPerPixelY() As Single
Dim lngDC As Long
lngDC = GetDC(HWND_DESKTOP)
TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
ReleaseDC HWND_DESKTOP, lngDC
End Function
Nécessite au minimum d'une configuration WindowsXP.
Testé avec Excel2002/Excel2007.
Nota:
Tous les fichiers du répertoire à compresser doivent être préalablement fermés.
Sub ZipRepertoire()
'
'Source
'http://www.codecomments.com/archive299-2006-2-295877.html
'
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim Source, Destination, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
'Spécifiez le répertoire
Source = "C:\Le répertoire"
Destination = "C:\maSauvegarde.zip"
MyHex = _
Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next
Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")
'Création de la base du fichier zip.
Set oCTF = oFileSys.CreateTextFile(Destination, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.Namespace(Source)
If Not oFolder Is Nothing Then _
oApp.Namespace(Destination).CopyHere oFolder.Items
Set oFile = Nothing
On Error Resume Next
Do While (oFile Is Nothing)
'Attention: provoque une erreur 70 si un des fichiers à zipper
'est toujours ouvert.
Set oFile = oFileSys.OpenTextFile(Destination, ForAppending, False)
If Err.Number <> 0 Then
Err.Clear
End If
Loop
Set oFile = Nothing
Set oFileSys = Nothing
End Sub
Nécessite au minimum d'une configuration WindowsXP.
Testé avec Excel2002/Excel2007.
Sub ZipFichier()
'
'Source
'http://www.codecomments.com/archive299-2006-2-295877.html
'
Dim oShell As Object, Fso As Object
Dim i As Long
Dim Fichier As String, MyBinary As String
Dim LeZip As Variant
Dim MyHex As Variant
Fichier = "C:\le classeur.xls"
LeZip = "C:\Ma sauvegarde.zip"
Set Fso = CreateObject("Scripting.FileSystemObject")
MyHex = _
Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next
With Fso.CreateTextFile(LeZip, True)
.Write MyBinary
.Close
End With
Set oShell = CreateObject("Shell.Application")
oShell.Namespace(LeZip).CopyHere (Fichier)
Set oShell = Nothing
End Sub