Correction Code Boite incrementation probleme ComboBox

[PEX]

bonjour à tous,

je suis sur la redaction d'un code VBA pour une boite de dialogue d'incrémentation!

mon soucis vient du faits que dans ma combobox des lignes vide apparraisse suite a l'incrementation. Je souhaiterai quel n'apparaisse pas dans ma combobox. comment faire ?

Maintenant j'ai un autre soucis au niveau de l'incrementation. Le code marche mais lors de l'enregistrement, au lieu de mettre les valeurs saisi au niveau de la ligne ou en dessous, le code copie automatique les valeurs a la ligne L +1. comment corriger se souci ?

Private Sub Userform_initialize()

Dim Cell As Range
    
With Sheets("primaire")
        For Each Cell In .Range("A3:A" & .Range("A65536").End(xlUp).Row)
            Me.ComboBox1.AddItem (Cell)
            ComboBox1.ListIndex = 0
        Next
    End With
End Sub

Private Sub save_Click()
Dim Adh As String
Dim ref As String
Dim DtEnt As Integer
Dim dtsort As Integer
Dim nbH As Integer
Dim Lg As Long, dLg As Long

Adh = ComboBox1

DtEnt = TextBox2
dtsort = TextBox1
nbH = TextBox3
With Sheets("primaire")
  dLg = .Range("R" & Rows.Count).End(xlUp).Row
  Set R = ThisWorkbook.Sheets("primaire").Range("A:A").Find(what:=ComboBox1.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
  If Not R Is Nothing Then
    Lg = R.Row + 1
    While Cells(Lg, 1).Offset(0, 1) = "" And Lg <= dLg
      Lg = Lg + 1
    Wend
    .Range("A" & Lg).EntireRow.Insert
    Else
    Lg = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & Lg) = what
  End If
  .Range("R" & Lg) = dtsort
  .Range("S" & Lg) = nbH
  .Range("T" & Lg) = DtEnt
End With
Unload Me
End Sub

Private Sub quit_Click()
Unload Me
End Sub

Cordialement

Pex😕

 

[gilbert_RGI]

Re : Correction Code Boite incrementation probleme ComboBox

Bonjour

un petit exemple

 

[PEX]

Re : Correction Code Boite incrementation probleme ComboBox

Bonjour

un petit exemple

merci beaucoup voici le code corrigé 🙂

Private Sub UserForm_Initialize()

[B][I]Dim lf As Long 
Sheets("Primaire").Select
lf = Range("A65536").End(xlUp).Row 
ComboBox1.Clear 
For Each cel In Range("A2:A" & lf) 

If cel.Value <> "" Then ComboBox1.AddItem cel.Value
Next cel [/I][/B]
    
    ' affichage valeur de départ pour calendrier ( Date d'aujourdhui )

    datesortie.Value = "../../.."
    UserForm_Activate
    
    daterentree.Value = VBA.Format(VBA.Date, "dd/mm/yyyy")
    UserForm_Activate

    
End Sub
Private Sub save_Click()
Dim Adh As String
Dim ref As String
Dim DtEnt As Date
Dim dtsort As Date
Dim nbH As Integer
Dim Lg As Long, dLg As Long

Adh = ComboBox1

DtEnt = daterentree
dtsort = datesortie
nbH = TextBox3
With Sheets("primaire")
  dLg = .Range("R" & Rows.Count).End(xlUp).Row
  Set R = ThisWorkbook.Sheets("primaire").Range("A:A").Find(what:=ComboBox1.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
  If Not R Is Nothing Then
    Lg = R.Row + 1
    While Cells(Lg, 1).Offset(0, 1) = "" And Lg <= dLg
      Lg = Lg + 1
    Wend
    .Range("A" & Lg).EntireRow.Insert
    Else
    Lg = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & Lg) = what
  End If
  .Range("R" & Lg) = dtsort
  .Range("S" & Lg) = nbH
  .Range("T" & Lg) = DtEnt
End With
Unload Me
End Sub

Private Sub quit_Click()
Unload Me
End Sub


' mise en forme des calendriers

Private Sub UserForm_Activate()

    With datesortie
        .SetFocus
        .SelStart = 0
        .SelLength = Len(datesortie)
        
        End With
        
    With daterentree
        .SetFocus
        .SelStart = 0
        .SelLength = Len(daterentree)
        End With
        
  
End Sub

'affichage des calendriers
    
Private Sub datesortie_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

calendrier_incrementation.Show
    
End Sub

Private Sub daterentree_dblclick(ByVal Cancel As MSForms.ReturnBoolean)

   calendrier_incrementation_entre.Show
    
End Sub

'valeur

Private Sub continuer_Click()

    Selection = DateValue(datesortie.Value)
        
    Unload Me
    
End Sub

    Selection = DateValue(daterentree.Value)
    
    Unload Me
    
End Sub

 

[PEX]

Re : Correction Code Boite incrementation probleme ComboBox

Je joints un fichier pour comprendre ma difficulté au niveau de l'incrémentation !

le code marche mais renseigne la saisi une ligne trop bas a chaque fois ! j'aimerai pouvoir corriger se detail.

PS : comment faire aussi pour la fonction recherche pour que s'il ya des lignes d'incrementation pour quel soit affiché ?

cordialement

Pex