Les meilleurs sources pour ExcelConsultez toutes les FAQ

Nombre d'auteurs : 10, nombre de questions : 65, dernière mise à jour : 8 février 2020 

 
OuvrirSommaireInterface

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.

Créé le 15 mai 2007  par SilkyRoad

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.

Créé le 15 mai 2007  par SilkyRoad

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.

Créé le 15 mai 2007  par khany

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.

Créé le 15 mai 2007  par Arkham46

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 :

Vba
Sélectionnez
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
Créé le 17 juin 2007  par nico-pyright(c)

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.

Vba
Sélectionnez
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
Créé le 17 juin 2007  par SilkyRoad

Nécessite au minimum d'une configuration WindowsXP.
Testé avec Excel2002/Excel2007.

Vba
Sélectionnez
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
Créé le 17 juin 2007  par SilkyRoad
  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2007 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.