test cellule

Question

Bonjour 

Je suis novice en Visual Basic, je cherche une fonction ou une macro me permettant de teste un groupe de cellules qui sont renseign&#233;es au fur et a mesure. Et qui lorsque celle ci sont remplies, on passe automatiquement &#224; la ligne du dessous tout en sauvegardant le fichier, un peu comme une base de donn&#233;es.

Merci pour votre aide

jpleroisse · Answer

Comment veux-tu que les donn&#233;es soient plac&#233;es dans les cellules ??
A partir d'un UserForm avec TextBox, Label ou autres??
Explique un peu !

jpleroisse

cs_dominic67 · Answer

Bonjour 

J'utilise justement Userform et textbox ( dont la valeur est mise dans une cellule ). La page excel est justement verouill&#233;e afin de ne pas efface les differentes infos. Le programme est concu pour une utilisation professionnelle et il y a justement des personnes qui ne maitrisent pas trop l'informatique.
Merci pour votre aide

jpleroisse · Answer

Voici un exemple de code.
Dans cet exemple j'ai plac&#233; sur un Userform un CommandButton et 2 TextBox
txtNom et txtPr&#233;nom dont les donn&#233;es seront plac&#233;es dans la feuil1.

Private Sub CommandButton1_Click()
Dim LigneSuivante As Long
'S'assure que la Feuil1 est s&#233;lectionn&#233;e
'Enl&#232;ve la protection de la feuil1
Sheets("Feuil1").Activate
ActiveSheet.Unprotect
'd&#233;termine la ligne suivante vide
LigneSuivante = Application.WorksheetFunction.CountA(Range("A:A")) + 1
'Transfert le contenu de txtnom et txtPr&#233;nom
Cells(LigneSuivante, 1) = txtNom
Cells(LigneSuivante, 2) = txtPr&#233;nom
'vide les contr&#244;les pour la prochaine entr&#233;e
txtNom = ""
txtPr&#233;nom = ""
txtNom.SetFocus
'Remet la protection de la feuil1
ActiveSheet.Protect
End Sub

Pour sauvegarder, soit tu sauvegarde en quittant le classeur normalement ou tu quittes &#224; partir du UserForm. dans ce cas tu cr&#233;es un Bouton "Quitter" et tu places dans le code.
soit  Application.Quit ou

Private Sub cmdQuitter_Click()
Dim Classeur As WorkBook
For Each Classeur In WorkBooks
If Classeur.Name <> ThisWorkBook.Name Then
Classeur.Close saveChanges:=True
End If
Next Classeur
Classeur.Close SaveChanges:=True
End sub

jpleroisse

valtrase · Answer

Tiens ce code a tester (J'ai &#233;crit mais pas encore test&#233;)
AddBase te permet de rajouter des valeurs &#224; une cl&#233; un peu &#224; la mani&#232;re de setsetting
les autres fonctions v&#233;rifient l'existance de la feuille et au cas ou la cr&#233;e.
tout ceci est &#224; mettre dans un module me tenir au courant si &#231;a bogue !!!!
Pour l'appel tu fais
addbase "IciLeNomDeTaCl&#233;" , TextBox1,"MaFeuilleDeDonn&#233;es"

Sub AddBase(Cl&#233; As String, Value As String, Optional sht As String = "xlBase")
Dim Col As Long, Row As Long
If Not (FeuilleExiste(sht)) Then CreateSheet (sht)


With Sheets(sht).Rows(1)
Col = .Find(What:=Cl&#233;, LookIn:=xlValue, lookat:=xlWhole, XlSearchDirection:=xlNext, _
    MatchCase:=False, XlSearchOrder:=xlByColumns).Column
If Col = 0 Then
    Col = .Find(What:="*", LookIn:=xlValue, lookat:=xlWhole, XlSearchDirection:=xlPrevious, _
    MatchCase:=False, XlSearchOrder:=xlByColumns).Column
    Col = Col + 1
End If
End With


With Sheets(sht).Columns(Col)
    Row = .Find(What:=Value, LookIn:=xlValue, XlSearchDirection:=xlNext, XlSearchOrder:=xlByRows).Row
    If Row = 0 Then
        Row = .Find(What:="*", LookIn:=xlValue, XlSearchDirection:=xlPrevious, XlSearchOrder:=xlByRows).Row
        Row = Row + 1
    End If
End With
With Sheets(sht)
    .Cells(Row, Col).Value = Cl&#233;
End With
End Sub

' V&#233;rifie l'existance d'une feuille
Function FeuilleExiste(Nom$) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  Err.Clear
End Function

'CreateSheet te permet de cr&#233;er un feuille soit avec ton nom soit avec un nom pr&#233;d&#233;fini dans ce cas elle est cach&#233;e

Function CreateSheet(Optional rName As String = "xlOptions") As Boolean
Dim rSheet As String
If FeuilleExiste(rName) Then Exit Function
rSheet = ActiveSheet.Name


On Error GoTo CreateSheet_Err


Worksheets.Add after:=Worksheets(Sheets.Count)
        With ActiveSheet
        .Name = rName        If rName "xlOptions" Or rName "xlIni" Or rName = "xlBase" Then
            .Range("A1").AddComment "ATTENTION CETTE FEUILLE NE DOIS PAS ETRE EFFACE !!!!!!"
            .Visible = xlSheetVeryHidden
        End If
        End With
        CreateSheet = True
        Sheets(rSheet).Select
Exit Function
CreateSheet_Err:
    MsgBox Err.Description, vbCritical, "Erreur de l'application"
    CreateSheet = False


End Function

Cordialement, Jean-Paul  
______________________________________________________________________

Le Savoir n'a de valeur que s'il est partag&#233;

valtrase · Answer

oups ai vu deux probs

With Sheets(sht).Columns(Col)
    Row = .Find(What:=Value, LookIn:=xlValue, XlSearchDirection:=xlNext, XlSearchOrder:=xlByRows).Row
    If Row = 0 Then 'Pas trouv&#233; donc on cherche ligne vide
        Row = .Find(What:="*", LookIn:=xlValue, XlSearchDirection:=xlPrevious, XlSearchOrder:=xlByRows).Row
        Row = Row + 1
    ElseIf Row > 0 then Exit Sub 'si trouv&#233; on sort
    End If
End With
With Sheets(sht)
    .Cells(Row, Col).Value = Value
End With
End Sub

Cordialement, Jean-Paul  
______________________________________________________________________

Le Savoir n'a de valeur que s'il est partag&#233;

Test cellule

5 réponses

Discussions similaires