Comme déjà dit, outre les 15 contrôles standards ou intégrés, on peut ajouter des contrôles supplémentaires qui sont contenus dans des fichiers portant l'extension .OCX.
Pour l'exercice qui suit, nous allons utiliser Common Dialog encore une fois ainsi que RichTextBox , le contrôle qui permet d'éditer du texte au format RTF.

Pour charger Common Dialog : Voir le chapître 6 WBloc+

Pour charger RichTextBox :

• Si vous avez installez Visual Basic, vous devez posséder ce contrôle.
• Après avoir lancé l'éditeur VBA et inséré une feuille quelconque, ouvrez la fenêtre Contrôles supplémentaires du menu Outils puis cochez sur le contrôle Microsoft RichText Control, version 5.0 Le nouveau contrôle s'installera automatiquement dans la Boîte à outils.
• Si vous n'avez pas ce contrôle dans la liste, vérifiez que vous avez bien le fichier richtx32.ocx dans le répertoire Windows\System.
• Si vous n'avez pas Visual Basic, essayer de trouver le fichier richtx32.ocx.
• Quand vous aurez le fichier, vous devrez "enregistrer" le contrôle dans la base de registres Windows.
  Pour cela, il suffira de lancer, par exemple, la commande :

             regsvr32 richtx32.ocx
           

  Nota : Si vous récupérez ou achetez un nouveau contrôle, vous devrez l' enregistrer de la même façon.


• Si vous n'avez pas le fichier richtx32.ocxx il vous faudra vous contenter du contrôle Zone de Texte. Vous ne pourrez pas changer la police, sinon, le reste sera identique.
Vous pourrez quand même voir les résultats en lançant NoteCAD.exe en VB5 fourni ci-dessous.

• Public ou Private :
  Comme d'habitude, Public : la fonction peut être appelée de toute l'application, tandis qu'avec Private : uniquement de la même feuille ou module.
• Declare :
  L'instruction Declare signale que la procédure est externe.
  
• Nom :
  détermine le nom de la fonction tel qu'il sera utilisé dans le code.
  
• "Biliothèque" :
  C'est le nom de la bibliothèque (DLL) ou se trouve la fonction API appelée.
  Note : Ce nom qui doit être entre "guillemets", est indispensable car la fonction est chargée au moment de l'exécution du programme. La DLL doit se trouver dans le répertoire SYSTEM de Windows ou dans le répertoire du programme, sinon vous devez indiquer le chemin complet.
• "Nom_Origine" :
  Permet de déclarer une fonction tout en modifiant son nom, ce qui est nécessaire pour quelques fonctions API ayant des noms d'origine non autorisés en Visual Basic. Les guillemets sont nécessaires.
• ListArguments :
  De la même manière que la liste d'arguments d'une fonction normale, c'est la liste d'arguments donnant les paramètres attendus par la procédure, le type de variables (long, chaîne, entier, etc..) et indiquant s'ils sont passés par ByVal ou ByRef.
  
• As Type :
  Spécifie le type de donnée de la valeur retournée.

A chaque ouverture d'un dessin par AutoCAD, ce programme va afficher une feuille correspondant à ce dessin sur laquelle vous pourrez noter vos remarques ...
Si la feuille n'existe pas dans le même répertoire que celui du dessin, elle sera créée, sinon la feuille existante sera ouverte. La feuille s'enregistrera automatiquement à chaque fermeture.
Le contrôle RichTextBox permet de conserver au texte les caractéristiques de polices.
Le contrôle Common Dialog est utilisé pour changer la couleur de fond de la feuille.
Le bouton Insert Date affiche la date du jour sur la feuille à l'endroit du curseur, suivi du nom de l'utilisateur et du nom de la machine.

A la suite de ce fichier en VBA, je vous propose une version améliorée en VB5, puisqu'elle aura l'avantage de pouvoir rester ouverte tout en utilisant AutoCAD et d'autres macros VB ou VBA, ce qui n'est pas possible en VBA.

• On conserve le nom UserForm1
• Modifiez la propriété Caption par NoteCAD

• Le signe souligné _ en fin de ligne signale à VB ou VBA que l'instruction continue sur la ligne suivante.
• Fonctions API : les fonctions API doivent être déclarées avant utilisation. La première ligne est la déclaration de la fonction API qui va servir à imprimer.
• Nom de fichier : on récupère le chemin et le nom du dessin en cours et on ajoute l'extension rtf. Si vous n'avez pas de contrôle RichTextBox, remplacez rtf par txt.

Public 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
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
   (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA"_
   (ByVal lpBuffer As String, nSize As Long) As Long
 
Option Explicit
'Initialisation des variables
    Public FichNote As String
    Public numfich As Integer
    Public Const SW_SHOWMINNOACTIVE = 7     ' pour sortie imprimante
       
Public Sub NoteCAD()
    On Error Resume Next
    FichNote = ThisDrawing.FullName
    If FichNote <> "" Then                          ' Pour être sûr que ce n'est pas un dessin sans nom
      FichNote = Left$(FichNote, Len(FichNote) - 3) ' on retire le nom à la fin du chemin
      FichNote = FichNote + "rtf"
    Else
      FichNote = "TempNote.rtf"
    End If
    UserForm1.Show
End Sub

Public Function UserName() As String
    'Fonction pour retrouver le nom de l'utilisateur :
    Dim strBuffer As String
    Dim lngBuffer, lngRetour As Long
    
    lngBuffer = 255
    strBuffer = Space$(lngBuffer)
    lngRetour = GetUserName(strBuffer, lngBuffer)	; Appel de la fonction API
    If lngRetour > 0 Then
      ' Succès, strBuffer contient le nom,
      ' lngBuffer la longueur de ce nom + 1 caractère à enlever
      UserName = Left$(strBuffer, lngBuffer - 1)
    Else    ' insuccès, pas de non
      UserName = ""
    End If

End Function

Public Function ComputerName() As String
    ' Fonction pour retrouver le nom de l'ordinateur :
    Dim strBuffer As String
    Dim lngBuffer, lngRetour As Long
    
    lngBuffer = 255
    strBuffer = Space$(lngBuffer)
    lngRetour = GetComputerName(strBuffer, lngBuffer)	; Appel de la fonction API
    If lngRetour > 0 Then
      ' Succès, strBuffer contient le nom,
      ' lngBuffer la longueur de ce nom
      ComputerName = Left$(strBuffer, lngBuffer)
    Else    ' insuccès, pas de non
      UserName = ""
      ComputerName = ""
    End If
   
End Function

• A l'initialisation du programme, lecture du fichier puis affichage.
• On error Resume next : en cas d'erreur, continuer ligne suivante.
• FreeFile : numéro de fichier libre.
• Open on ouvre le fichier, s'il existe.
  Si le fichier n'existe pas encore, donnerait un message d'erreur s'il n'y avait pas On error Resume next
• Temp = Input(LOF... Lecture de toutes les données séquentielles du fichier et affectation du contenu à la variable Temp
• Close : fermeture du fichier.

Sub UserForm_Initialize()
    On Error Resume Next
    numfich = FreeFile
    Open FichNote For Input As #numfich
    Temp = Input(LOF(numfich), #numfich)
    Close #numfich
    TxtNote = Temp
End Sub

• Affichage de la boîte Police de Common Dialog

Private Sub cmdPolice_Click()
    ' Procédure de changement de police
    ' et affichage de la boîte Microsoft
    CommonDialog1.CancelError = True
    On Error GoTo ErrStop
    ' Flags (Voir signification dans l'aide en ligne
    CommonDialog1.Flags = &H303&
    ' Méthode utilisée
    CommonDialog1.ShowFont
    ' Récupération des caractéristiques de la nouvelle police
    With TxtNote
        .SelFontName = CommonDialog1.FONTNAME
        .SelFontSize = CommonDialog1.FONTSIZE
        .SelBold = CommonDialog1.FONTBOLD
        .SelItalic = CommonDialog1.FONTITALIC
        .SelStrikeThru = CommonDialog1.FontStrikethru
        .SelUnderline = CommonDialog1.FontUnderline
        .SelColor = CommonDialog1.Color
        .Refresh
    End With
Exit Sub
ErrStop:
    MsgBox "Une erreur s'est produite !"
Exit Sub
End Sub

• Affichage de la boîte Couleur de Common Dialog.
• Nota : La couleur appliquée n'est pas sauvegardée dans le fichier.

Private Sub cmdFond_Click()
    ' Procédure de changement de couleur de fond
    ' et affichage de la boîte Microsoft
    CommonDialog1.CancelError = True
    On Error GoTo ErrStop
    ' Flag
    CommonDialog1.Flags = &H1&
    ' Méthode utilisée
    CommonDialog1.ShowColor
    ' Application de la nouvelle couleur du fond
    TxtNote.BackColor = CommonDialog1.Color
Exit Sub
ErrStop:
    MsgBox "Une erreur s'est produite !"
Exit Sub

End Sub

• Formattage et affichage de la date système.

Private Sub cmdDate_Click()
    Dim strDate As String
    ' Formatage de la date
    strDate = Format(Date, "dddd d mmm yyyy")
    TxtNote.SelBold = True              ' En gras
    TxtNote.SelUnderline = True         ' Souligné
    ' Affichage de la date puis des noms par appel des fonctions
    TxtNote.SelText = "Le " & strDate & " par " & UserName & " sur " & ComputerName
    TxtNote.SelBold = False             ' Non gras
    TxtNote.SelUnderline = False        ' Non souligné
End Sub

• Note : L'objet Printer n'existe pas en VBA pour AutoCAD. Il est remplacé par l'objet Plot qui n'est pas aussi souple.
• On se sert ici de la boîte Impression de Common Dialog. pour choisir l'imprimante.
• On enregistre la note dans le fichier parce que la fonction API que l'on utilise sert à imprimer un fichier.
• Appel de la fonction API ShellExecute .

Private Sub cmdImprim_Click()
    ' Procédure Impression
    Dim lngRetour As Long
     On Error GoTo ErrImprim
    ' Méthode utilisée
    If TxtNote.SelLength > 0 Then
        CommonDialog1.Flags = &H1
        Else
        CommonDialog1.Flags = &H0
    End If
    CommonDialog1.ShowPrinter
    ' Récupère les valeurs définies par l'utilisateur
    ' dans la boîte de dialogue
    ' Enregistrement de la note dans le fichier de sortie
    numfich = FreeFile
    Open FichNote For Output As #numfich
    Print #numfich, TxtNote
    Close #numfich
    ' Appel de la fonction API pour impression du fichier
    lngRetour = ShellExecute(TxtNote.hwnd, "print", FichNote, ByVal 0&, 0&, SW_SHOWMINNOACTIVE)
    Exit Sub
ErrImprim:
    MsgBox "Une erreur s'est produite à l'impression !"
    Resume Next
Exit Sub

End Sub

• Ces 2 procédures sont identiques.
• En fait, la procédure Private Sub cmdFin_Click() est inutile. Elle a été ajoutée seulement parce que beaucoup d'utilisateurs sont désorientés si dans un programme, il n'y a pas de bouton de sortie.
• La procédure Private Sub UserForm_QueryClose est exécutée automatiquement si on utilise la sortie système d'un programme. Dans ce cas précis, le contenu de la note sera sauvegardé avant de rendre la main.

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ' Ouverture fichier, enregistrement puis fermeture
    ' si sortie du programme sans passer "par la porte"
    numfich = FreeFile
    Open FichNote For Output As #numfich
    Print #numfich, TxtNote
    Close #numfich
End Sub

Private Sub cmdFin_Click()
    numfich = FreeFile
    Open FichNote For Output As #numfich
    Print #numfich, TxtNote
    Close #numfich
    Unload Me
End Sub

	(startapp "C:/acadr14/vbmacro/notecad.exe")