Microsoft 365 Saut de ligne dans une cellule

[GClaire]

Hello la communauté

Je suis sur un fichier Excel, ou le résultat sera utilisé pour remplir des vignettes dans le logiciel QuizzXpress.

Voici le code :

[CODE]'MANCHE 1
            Case 1
                countTheme1 = countTheme1 + 1
                If countTheme1 <= NbChoixTheme1 Then
                    wsExport.Cells(16, 1).Value = "Manche 1" & vbCrLf & vbCrLf & vbCrLf & "1/3" & vbCrLf & vbCrLf & vbCrLf & "Theme : " & wsBase.Cells(i, 19).Value
                End If

Je rempli une cellule, qui dans le texte doit avoir des sauts de lignes
(Photo 1)

Le soucis est que le soft QuizXpress, importe bien, mais rajoute un texte (_x000D_) a chaque saut de lignes avec "vbCrLf" (Photo 2)

J'ai ce code qui permet de supprimer le retour automatique de cellule

Sub DesactiverRetourAutomatiqueMaxiQuizz()
    Dim ws As Worksheet
    Dim rng As Range
  
    ' Spécifie la feuille de calcul "Export (Maxi Quizz)"
    Set ws = ThisWorkbook.Sheets("Export (Maxi Quizz)")
  
    ' Spécifie les cellules à modifier
    Set rng = ws.Range("A16,A33,A52,A77,A91,A140")
  
    ' Désactive le retour automatique à la ligne
    rng.WrapText = False

ExportDataMaxiQuizz

End Sub

Ensuite cette procédure qui envoie les données dans la feuille "Export (Maxi Quizz)"

'------------------------------------------------------
'- J'exporte les données vers leur manches Maxi Quizz -
'------------------------------------------------------
Sub ExportDataMaxiQuizz()
    Dim baseSheet As Worksheet
    Dim exportSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim exportRow As Long
  
    ' Spécifier les feuilles de calcul
    Set baseSheet = ThisWorkbook.Sheets("Base")
    Set exportSheet = ThisWorkbook.Sheets("Export (Maxi Quizz)")
  
    ' Trouver la dernière ligne dans la colonne O de la feuille "Base"
    lastRow = baseSheet.Cells(baseSheet.Rows.count, "O").End(xlUp).row
  
    ' Initialiser la ligne de départ dans la feuille "Export (Maxi Quizz)"
    exportRow = 18
  
    ' Parcourir les valeurs dans la colonne O à partir de la ligne 5
    For i = 5 To lastRow
        If baseSheet.Cells(i, "O").Value = 1 Then
            ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz)"
            For j = 1 To 8
                exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
            Next j
            exportRow = exportRow + 1
        End If
    Next i
  
exportRow = 37

    For i = 5 To lastRow
        If baseSheet.Cells(i, "O").Value = 2 Then
            ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz)"
            For j = 1 To 8
                exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
            Next j
            exportRow = exportRow + 1
        End If
    Next i

 exportRow = 79

    For i = 5 To lastRow
        If baseSheet.Cells(i, "O").Value = 3 Then
            ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz)"
            For j = 1 To 8
                exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
            Next j
            exportRow = exportRow + 1
        End If
    Next i

 exportRow = 93

    For i = 5 To lastRow
        If baseSheet.Cells(i, "O").Value = 4 Then
            ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz)"
            For j = 1 To 8
                exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
            Next j
            exportRow = exportRow + 1
        End If
    Next i

 exportRow = 143

    For i = 5 To lastRow
        If baseSheet.Cells(i, "O").Value = 5 Then
            ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz)"
            For j = 1 To 8
                exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
            Next j
            exportRow = exportRow + 1
        End If
    Next i

 exportRow = 178

    For i = 5 To lastRow
        If baseSheet.Cells(i, "O").Value = 6 Then
            ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz)"
            For j = 1 To 8
                exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
            Next j
            exportRow = exportRow + 1
        End If
    Next i

MsgBox "Les manches du Maxi Quizz ont bien étaient crées", vbInformation

    ' Nettoyer les variables
    Set baseSheet = Nothing
    Set exportSheet = Nothing
  
ExportMaxiQuizz

End Sub

Et cette procédure pour créer un nouveau classeur avec une feuille export (se sera elle qui sera utilisait pour le soft)

'------------------------------------------------------------------------------------------------------
'-Création d'un nouveau classeur avec le feuille "Export" + sauvegarde dans un dossier de destination"-
'------------------------------------------------------------------------------------------------------

Sub ExportMaxiQuizz()

Dim wsSource As Worksheet
Dim newWorkbook As Workbook
Dim destinationFolder As String
Dim filePath As String
Dim fileName As String
  
' Vérifier si le chemin de fichier est déjà enregistré dans la cellule B3 de la feuille "Paramètres"
If Worksheets("Paramètres").Range("B3").Value = "" Then
    ' Si la cellule est vide, choisir le dossier de destination
    destinationFolder = Application.GetSaveAsFilename(InitialFileName:="Export (Maxi Quizz)", fileFilter:="Excel Files (*.xlsx), *.xlsx")
        If destinationFolder = "Faux" Then Exit Sub ' L'utilisateur a annulé
            ' Enregistrer le chemin de fichier dans la cellule B3 de la feuille "Paramètres"
            Worksheets("Paramètres").Range("B3").Value = destinationFolder
        Else
            ' Utiliser le chemin de fichier déjà enregistré dans la cellule B3 de la feuille "Paramètres"
            destinationFolder = Worksheets("Paramètres").Range("B3").Value
End If

' Copier la feuille "Export (Maxi quizz)"
Set wsSource = ThisWorkbook.Sheets("Export (Maxi quizz)")

wsSource.Copy

Set newWorkbook = ActiveWorkbook

' Renommer la feuille dans le nouveau classeur
newWorkbook.Sheets(1).Name = "Export"

' Enregistrer le nouveau classeur avec le nom "Export (Maxi Quizz)"
filePath = destinationFolder

If Right(filePath, 5) <> ".xlsx" Then 'Il y avait 4 a la place de 5
    If Right(filePath, 1) <> "\" Then filePath = filePath & "\"
    filePath = filePath & "Export (Maxi Quizz).xlsx"
End If

If Dir(filePath) <> "" Then
    ' Si le fichier existe déjà, demander à l'utilisateur s'il veut le remplacer
    If MsgBox("Le fichier Export (Maxi Quizz) existe déjà." & vbCrLf & vbCrLf & "Voulez-vous le remplacer ?", vbYesNo) = vbNo Then
        newWorkbook.Close False
        Exit Sub
    Else
        ' Supprimer le fichier existant
        Kill filePath
    End If
End If

newWorkbook.SaveAs fileName:=filePath
newWorkbook.Close False

MsgBox "Le fichier Export (Maxi Quizz) a bien était exporté dans : " _
& vbCrLf & vbCrLf & filePath, vbInformation

End Sub

Avez-vous une idée de comment je pourrais remédier a cela?

Es-ce qu'il y'a un autre moyen de créer ces sauts de lignes dans une cellules?

Je vous remercie par avance.

Passez une bonne journée.

G'Claire

 

[fanch55]

Bonsoir,
Remplacez les Vbcrlf par des VbLf, ce devrait être suffisant .

 

[GClaire]

Hello fanch55

Bonsoir,
Remplacez les Vbcrlf par des VbLf, ce devrait être suffisant .

Merci pour la réponse rapide.

je test de ce pas

Bonne soirée.

 

[GClaire]

Hello la communauté.

fanch55.

Nickel, mon pote a fait le test et cela fonctionne.

J’ai était voir la différence entre les deux pour comprendre.

En faite il y a 3 codes presque

Vbcr : retour charriot
VbLf : passer à la ligne
Vbcrlf : fait les deux.

Encore merci.

Bonne journée, GClaire.