Résolu Code fonctionne en pas à pas détaillé mais pas à partir d'un lancement normal

piga25

XLDnaute Barbatruc
Bonjour le Forum
Mes connaissances en VBA sont vraiment trop limitées. Je commence à capituler devant un problème qui devrait être simple pour certains.
Lorsque je lance cette macro
VB:
Private Sub CommandButton1_Click()
Prepare
Concatene
UserForm2.TextBox4.Value = f.[N1].Value
Me.Main.Clear
Unload Me
UserForm2.Show
End Sub
j'ai à chaque fois un bug sur celle-ci à la commande .ClearContents
Code:
Sub Concatene()
Dim Cel As Range, Co As Range
Dim Lg As Long
    Application.ScreenUpdating = False
        Lg = [O65536].End(xlUp).Row
    With Range("N1")
       .ClearContents
            For Each Cel In Range("o2:o" & Lg)
                If Cel <> "" Then
                    .Value = .Value & Cel.Value & Chr(10)                 
                  Else: Exit For
                End If
            Next Cel
    End With
End Sub
Par contre lorsque je fais un débogage pas à pas détaillé tout fonctionne.
Merci
 

Fichiers joints

Dernière édition:

ChTi160

XLDnaute Barbatruc
Bonjour piga25
Bonjour le fil , le Forum
Il semble que tu doives préciser la feuille Cible ou doit s'appliquer la procédure.
VB:
Sub Concatene()
Dim Cel As Range, Co As Range
Dim Lg As Long
    Application.ScreenUpdating = False
With Worksheets("Mouvement")'Ici
        Lg = [O65536].End(xlUp).Row
    With .Range("N1")
       .ClearContents
            For Each Cel In .Range("o2:o" & Lg)
                If Cel <> "" Then
                    .Value = .Value & Cel.Value & Chr(10)               
                  Else: Exit For
                End If
            Next Cel
    End With
End With 'Ici
End Sub
car si tu te positionnes sur la feuille"Mouvement" et que tu lances le "Userform8" ça semble fonctionner
pas évident lol
Bonne journée
jean marie
 
Dernière édition:

ChTi160

XLDnaute Barbatruc
Re
ce que j'ai modifié et qui semble fonctionner
VB:
Sub Prepare()
Application.ScreenUpdating = False
With Sheets("Mouvement")
  .Range("O2:O50").ClearContents
k = [S1]
    If k > 0 Then
        For i = 2 To k + 1
        
            .Range("O" & i).Select
            ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[3],"" de "",RC[2],"" à "",RC[4])"
        Next i
    End If
End With
End Sub

Sub Concatene()
Dim Cel As Range, Co As Range
Dim Lg As Long
    Application.ScreenUpdating = False
        Lg = [O65536].End(xlUp).Row
  With Worksheets("Mouvement")
        .Range("N1").ClearContents
            For Each Cel In .Range("o2:o" & Lg)
                If Cel <> "" Then
                  With .Range("N1")
                       .Value = .Value & Cel.Value & Chr(10)
                  End With
                  Else: Exit For
                End If
            Next Cel
  End With
End Sub
perfectible !
je pense que l'on peut transférer la Concaténation sans passer par la cellule N1.
jean marie
 
Dernière édition:

ChTi160

XLDnaute Barbatruc
Re
j'ai supprimé la procédure concaténer et modifié
la procédure "Prepare" ainsi
VB:
Public Str1 As String
Public DerLgn As Integer
Public Lgn As Integer
Sub Prepare()
Application.ScreenUpdating = False
 Str1 = ""
With Sheets("Mouvement")
DerLgn = .Cells(10000, 17).End(xlUp).Row
    If DerLgn > 1 Then
        For Lgn = 2 To DerLgn
           Str1 = Str1 & .Cells(Lgn, 18) & " de " & .Cells(Lgn, 17) & " à " & Cells(Lgn, 19) & Chr(10)
        Next Lgn
    End If
End With
UserForm2.TextBox4.Text = Str1
End Sub
on pourrait aussi passé par un tableau temporaire
jean marie
 

piga25

XLDnaute Barbatruc
Bonjour Jean Marie, le Forum
Tu me sauve, l'idée de passer par un tableau est vraiment très bien.
Neanmoins, j'avais une erreur sur la ligne qui vide le tableau. J'ai déplacé celle-ci en fin de commande, comme cela lors de l'ouverture le tableau est déjà vide.
VB:
Sub Prepare()
Application.ScreenUpdating = False

With Sheets("Mouvement")
DerLgn = .Cells(10000, 17).End(xlUp).Row
    If DerLgn > 1 Then
    TabTemp = .Range(.Cells(1, 17), .Cells(DerLgn, 19)).Value
        For Lgn = 2 To UBound(TabTemp, 1)
           Str1 = Str1 & TabTemp(Lgn, 2) & " de " & TabTemp(Lgn, 1) & " à " & TabTemp(Lgn, 3) & Chr(10)
        Next Lgn
    End If
End With
      UserForm2.TextBox4.Text = Str1
 Str1 = "": Erase TabTemp
End Sub
 

job75

XLDnaute Barbatruc
Bonjour piga25, Jean-Marie, le forum,

Voyez le fichier joint, cette macro - sans boucle - est appelée depuis UserForm8 :
VB:
Sub Concatene()
Dim h&, tablo
With Sheets("Mouvement")
    h = Int(Val(.[S1]))
    .Range("N1,O2:O" & .Rows.Count).ClearContents
    If h < 1 Then Exit Sub
    .[O2].Resize(h) = "=R2&"" de ""&Q2&"" à ""&S2"
    tablo = Application.Transpose(.[O2].Resize(h))
    .[N1] = Join(tablo, vbLf)
End With
End Sub
Bonne journée.
 

Fichiers joints

piga25

XLDnaute Barbatruc
Re
J'ai ajouté également en dernière ligne de manière à ce que les prochaines commandes se fassent normalement.


Application.ScreenUpdating = False



Un très grand merci. :):)
 

piga25

XLDnaute Barbatruc
Bonjour Job75, Jean Marie, le forum
Encore mieux, c'était ma première idée mais je n'ai rien trouvé pour me donner une piste.
J'avais cherché comment remplir une textbox à partir d'une listbox.

Je vois maintenant que cela est possible.
Merci Job.
 

ChTi160

XLDnaute Barbatruc
Re
Pour ce qui est de l'erreur il faut remplacer Erase TabTemp par Set TabTemp=Nothing , ce qui vide le Tableau
mais je vois que tu as trouvé ton Bonheur !
jean marie
 

piga25

XLDnaute Barbatruc
RE
En ce qui concerne le choix final du fichier, pour le moment je ne sais pas, les deux me conviennent. Comme il sera utilisé sur plusieurs machines complètement différente, je verrai à ce moment là.
En tout cas merci à vous deux.
 

Discussions similaires


Haut Bas