lundi 3 août 2015

Intercepter touche Entrée dans un TextBox

Il suffit d'utiliser l'événement "KeyDown" et de vérifier si le code renvoyé correspond à la touche ENTREE

Private Sub TexBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        'mon code
    End If
End Sub

Selectionner le contenu d'un TextBox qui reçoit le focus

Pour sélectionner le contenu d'une zone de texte (TextBox), utiliser les propriétés SelStart et SelLength du composant.
Créer un TextBox sur un UserForm et placer le code ci-dessous dans une procédure qui donne le focus au TextBox :
(par exemple sur l'évènement Activate du UserForm)


Private Sub UserForm_Activate()
    Me.TextBox1.Value = "Valeur par défaut" 'pour avoir un contenu
    Me.TextBox1.SelStart = 0 'se positionne avant le premier caractère
    Me.TextBox1.SelLength = Len(Me.TextBox1.Text) 'indique la longueur de la sélection
    Me.TextBox1.SetFocus 'donne le focus
End Sub

vendredi 27 février 2015

Vérifier par VBA si un classeur est déjà ouvert sur le même PC ou en réseau

Placer ce code dans un module de l'éditeur VBA :


Sub TestSiClasseurOuvert()
    If Not FichierDejaOuvert("C:\Planning.xlsx") Then 'le chemin doit être renseigné
        MsgBox "Classeur pas ouvert"
    Else
        MsgBox "Classeur ouvert"
    End If
End Sub

Public Function FichierDejaOuvert(MonFichier As String) As Boolean  'Vérifie si un classeur est déjà ouvert
    On Error Resume Next
    Open MonFichier For Binary Access Read Lock Read As #1
    Close #1
    FichierDejaOuvert = IIf(Err.Number > 0, True, False)
    On Error GoTo 0
End Function

mardi 23 septembre 2014

Modifier par code le nom VBA d'une Feuille de Calcul (pas le nom de l'onglet)

Placer ce code dans une procédure ou une fonction dans l'éditeur VBA :

NomActuelVba= ActiveSheet.CodeName
ActiveWorkbook.VBProject.VBComponents(NomActuelVba).Name = "NomFeuilleCoteVBA"


A ne pas confondre avec ce code qui modifie le nom de l'onglet coté Excel :

ActiveSheet.Name = "NomFeuille"

mardi 17 décembre 2013

Nombre de jours ou mois ou années entre 2 dates

Voici 3 fonctions permettant de retrouver le nombre de jours ou de mois ou d'années entre 2 dates.
(la date 1 doit être inférieure à la date 2)

1) Placer le code suivant dans un module :

'Nombre d'années
Function DifDateAnnee(pDate1 As Date, pDate2 As Date) As Long
    DifDateAnnee = DateDiff("yyyy", pDate1, pDate2)
End Function

'Nombre de mois
Function DifDateMois(pDate1 As Date, pDate2 As Date) As Long
    DifDateMois = DateDiff("m", pDate1, pDate2)
End Function

'Nombre de jours
Function DifDateJour(pDate1 As Date, pDate2 As Date) As Long
    DifDateJour = DateDiff("d", pDate1, pDate2)
End Function


2) Puis faire appel à cette fonction dans une procédure quelconque :


Sub DifferenceEntre2Dates()
    
    Dim Date1 As Date, Date2 As Date
    Date1 = "01/12/2013"
    Date2 = "15/04/2016"
    
    MsgBox "Nombre d'années entre les 2 dates : " & DifDateAnnee(Date1, Date2)
    MsgBox "Nombre de mois entre les 2 dates : " & DifDateMois(Date1, Date2)
    MsgBox "Nombre de jours entre les 2 dates : " & DifDateJour(Date1, Date2)

End Sub

Trouver le numéro de la semaine à partir d'une date

Voici une fonction permettant de déduire le numéro de la semaine dans une année.
Attention à toujours vérifier pour une date qui s'approche du 31/12 (qui appartient donc à une semaine à cheval sur l'année suivante) : dans ce cas, cette fonction renverra la valeur 1 (pour la semaine 1 de l'année suivante).

1) Placer le code suivant dans un module :
Function Semaine(UneDate As Date) As Integer
   Semaine = Format(UneDate, "ww", , vbFirstFourDays)
End Function


2) Appeler la fonction de cette manière :
Sub NumeroDeSemaine ()
   MsgBox Semaine(#10/31/2013#)
End Function

mardi 27 août 2013

Créer un bouton "Parcourir" pour sélectionner un Répertoire (Excel, Word, Access)

1) Créer un bouton sur un Userform, puis gérer l'événement Click côté code en intégrant le code ci-dessous

Private Sub CommandButton1_Click()

    Dim Repertoire As FileDialog
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
        MsgBox Repertoire.SelectedItems(1)
    Else
        MsgBox "Aucun Répertoire Sélectionné"
    End If

End Sub