String limité à 255 caractères

Le 22/08/2017 à 09:46

Bonjour à tous,

J'ai mis au point une macro permettant la création de questions auxquels ont répond avec un modèle préétabli. J'ai créé un userform permettant de renseigner les différentes informations concernant la réponse. Seulement, je ne savais pas que les variable de type string sont limitée à 255 caractères (ce qui me paraît logique dorénavant ^^).

J'ai donc modifié ma macro, pour diviser (dans un premier temps) la question en 3 partie et donc avoir 3 variables de type string. De ce fait, la question pouvait faire 765 caractères. Mais ce matin, nous avons reçu une question faisant plus de 1700 caractères ...

Vous avez compris mon problème. J'ai essayer de créer de nouvelles "partie" et qu'elles s'étendent toutes sur 255 caractères. Seulement, c'est pas très fonctionnel, ni satisfaisant car seules les part1 et 2 se renseignent dans mon dossier word.

Par conséquent, je sollicite votre aide afin d'améliorer cette macro qu'elle puisse permettre d'inscrire ma question peu importe le nombre de caractère. Je vous remercie par avance et j'espère avoir été clair.

Ci-après le code :

Private Sub CommandButton1_Click()

Dim chemin As String
chemin = ("Z:\FAQ\")
Dim recap As String
recap = "Suivi FAQ.xlsx"
Dim modl As String
modl = "Modèle FAQ.docx"
Dim ordre As String
ordre = Right(TextBox1.Value, Len(TextBox1.Value) - 1)
Dim ann As String
ann = year(Now())
Dim nomrep As String
nomrep = TextBox5.Value

Dim part1 As String
Dim part2 As String
Dim part3 As String
Dim part4 As String
Dim part5 As String
Dim part6 As String
Dim part7 As String
Dim part8 As String
Dim part9 As String
Dim nbcar As Integer
nbcar = Len(TextBox8.Value)

part1 = Left(TextBox8.Value, 255)
part2 = ""
part3 = ""
part4 = ""
part5 = ""
part6 = ""
part7 = ""
part8 = ""
part9 = ""

If Len(part1) = 255 Then
part2 = Mid(TextBox8.Value, Len(part1), 255)
ElseIf Len(part2) = 255 Then
part3 = Mid(TextBox8.Value, Len(part1 & part2) + 1, 255)
ElseIf Len(part3) = 255 Then
part4 = Mid(TextBox8.Value, Len(part1 & part2 & part3) + 1, 255)
ElseIf Len(part4) = 255 Then
part5 = Mid(TextBox8.Value, Len(part1 & part2 & part3 & part4) + 1, 255)
ElseIf Len(part5) = 255 Then
part6 = Mid(TextBox8.Value, Len(part1 & part2 & part3 & part4 & part5) + 1, 255)
ElseIf Len(part6) = 255 Then
part7 = Mid(TextBox8.Value, Len(part1 & part2 & part3 & part4 & part5 & part6) + 1, 255)
ElseIf Len(part7) = 255 Then
part8 = Mid(TextBox8.Value, Len(part1 & part2 & part3 & part4 & part5 & part6 & part7) + 1, 255)
ElseIf Len(part8) = 255 Then
part9 = Mid(TextBox8.Value, Len(part1 & part2 & part3 & part4 & part5 & part6 & part8) + 1, 255)
End If

If TextBox1.Value = "" Then
MsgBox ("Aucun N°ordre n'est renseigné, impossible de continuer la procédure")
Exit Sub
ElseIf TextBox2.Value = "" Then
MsgBox ("La date renseignée est invalide")
Exit Sub
ElseIf TextBox3.Value = "" Then
MsgBox ("Veuillez renseigner l'origine de la question")
Exit Sub
ElseIf nomrep = "" Or Len(nomrep) < 3 Then
MsgBox ("Le nom du répertoire inscrit est invalide")
Exit Sub
ElseIf TextBox6.Value = "" Or TextBox7.Value = "" Then
MsgBox ("Veuillez renseigner le thème et l'objet de la question")
Exit Sub
ElseIf CheckBox1.Value = True And TextBox8.Value = "" Then
MsgBox ("Veuillez renseigner la question à traiter")
Exit Sub
End If

Dim i As Integer

    On Error Resume Next
    Workbooks(recap).Activate
    If Err <> 0 Then
    Workbooks.Open (chemin & recap)
    Sheets(1).Activate
    Else
    Workbooks(recap).Activate
    Sheets(1).Activate
    End If
    On Error GoTo 0

    On Error Resume Next
    MkDir (chemin & ann & "\")
    MkDir (chemin & ann & "\" & nomrep & "\")
    On Error GoTo 0

For i = 5 To 500
If Range("A" & i).Value = "" Then
Range("A" & i) = TextBox1.Value
Range("B" & i) = TextBox2.Value
Range("F" & i) = TextBox4.Value
Range("G" & i) = TextBox6.Value
Range("H" & i) = TextBox7.Value
Workbooks(recap).Close savechanges:=True

If CheckBox1.Value = True Then
    Set appWrd = CreateObject("Word.Application")
    appWrd.Visible = True
    Set docword = appWrd.documents.Open(chemin & modl)
    docword.Content.Find.Execute FindText:="Nq", ReplaceWith:=ordre & " / " & ann, Replace:=1
    docword.Content.Find.Execute FindText:="DateQ", ReplaceWith:=TextBox2.Value, Replace:=1
    docword.Content.Find.Execute FindText:="Orgn", ReplaceWith:=TextBox3.Value, Replace:=1
    docword.Content.Find.Execute FindText:="Thm", ReplaceWith:=TextBox6.Value, Replace:=1
    docword.Content.Find.Execute FindText:="Objt", ReplaceWith:=TextBox7.Value, Replace:=1
    docword.Content.Find.Execute FindText:="Crps1", ReplaceWith:=part1, Replace:=1
    docword.Content.Find.Execute FindText:="crps2", ReplaceWith:=part2, Replace:=1
    docword.Content.Find.Execute FindText:="crps3", ReplaceWith:=part3, Replace:=1
    docword.Content.Find.Execute FindText:="crps4", ReplaceWith:=part4, Replace:=1
    docword.Content.Find.Execute FindText:="crps5", ReplaceWith:=part5, Replace:=1
    docword.Content.Find.Execute FindText:="Crps6", ReplaceWith:=part6, Replace:=1
    docword.Content.Find.Execute FindText:="crps7", ReplaceWith:=part7, Replace:=1
    docword.Content.Find.Execute FindText:="crps8", ReplaceWith:=part8, Replace:=1
    docword.Content.Find.Execute FindText:="crps9", ReplaceWith:=part9, Replace:=1
    ' procédure d'enregistrement

    docword.SaveAs chemin & ann & "\" & nomrep & "\" & nomrep & ".docx" 'enregistre le fichier à la date du jour

    appWrd.Quit
End If

    Unload Me
Exit Sub
End If
Next i

End Sub

Le 22/08/2017 à 11:04

Bonjour,

les variables de type string ne sont pas limitées à 255 caractères, mais 2GB à condition d'avoir assez de mémoire.

La limitation provient sans doute d'une des fonctions de manipulation des strings. j'ignore laquelle.

Le 22/08/2017 à 11:09

Re,

Oui je viens de vérifier, tu as bien raison la variable n'est pas limitée (je ne douté pas de ta réponse mais il fallait que je vois).

J'ai mis la valeur de ma textebox dans la variable et afficher celle-ci dans une msgbox et elle n'est pas coupée.

Mais quand même, quand je remplace dans word la tâche est bien limitée à 255 caractères.

Quelqu'un aurait une idée ?

Cdlt,

NB : "erreur execution 5854 parametre de la chaine trop long"

Le 22/08/2017 à 11:22

Bonjour,

Si tu mettais tes 2 fichiers qu'on puisse essayer de t'aider ?

eric

Le 22/08/2017 à 11:34

Bonjour,

Je vous met les différents fichiers (3). Il faut savoir que la macro provient d'un menu en interaction avec de nombreux fichiers.

Merci à vous !!!!!!!!!!!!!!!!!!!!

76faq.xlsm (39.48 Ko)

80modele-faq.docx (28.40 Ko)

78suivi-faq.xlsx (26.40 Ko)

Le 22/08/2017 à 13:53

Merci à vous, j'ai trouvé une solution. Bizarrement c'est quand ont remplace quelque chose qu'on est limité à 255 caractères.

Voici le nouveau code, j'ai donc décidé d'intervenir par rapport à la place de la cellule dans le tableau :

Private Sub CommandButton1_Click()

Dim chemin As String
chemin = ("Z:\FAQ\")
Dim recap As String
recap = "Suivi FAQ .xlsx"
Dim modl As String
modl = "Modèle FAQ.docx"
Dim ordre As String
ordre = Right(TextBox1.Value, Len(TextBox1.Value) - 1)
Dim ann As String
ann = year(Now())
Dim nomrep As String
nomrep = TextBox5.Value
Dim quest As String
quest = TextBox8.Value

If TextBox1.Value = "" Then
MsgBox ("Aucun N°ordre n'est renseigné, impossible de continuer la procédure")
Exit Sub
ElseIf TextBox2.Value = "" Then
MsgBox ("La date renseignée est invalide")
Exit Sub
ElseIf TextBox3.Value = "" Then
MsgBox ("Veuillez renseigner l'origine de la question")
Exit Sub
ElseIf nomrep = "" Or Len(nomrep) < 3 Then
MsgBox ("Le nom du répertoire inscrit est invalide")
Exit Sub
ElseIf TextBox6.Value = "" Or TextBox7.Value = "" Then
MsgBox ("Veuillez renseigner le thème et l'objet de la question")
Exit Sub
ElseIf CheckBox1.Value = True And TextBox8.Value = "" Then
MsgBox ("Veuillez renseigner la question à traiter")
Exit Sub
End If

Dim i As Integer

    On Error Resume Next
    Workbooks(recap).Activate
    If Err <> 0 Then
    Workbooks.Open (chemin & recap)
    Sheets(1).Activate
    Else
    Workbooks(recap).Activate
    Sheets(1).Activate
    End If
    On Error GoTo 0

    On Error Resume Next
    MkDir (chemin & ann & "\")
    MkDir (chemin & ann & "\" & nomrep & "\")
    On Error GoTo 0

For i = 5 To 500
If Range("A" & i).Value = "" Then
Range("A" & i) = TextBox1.Value
Range("B" & i) = TextBox2.Value
Range("F" & i) = TextBox4.Value
Range("G" & i) = TextBox6.Value
Range("H" & i) = TextBox7.Value
Workbooks(recap).Close savechanges:=True

If CheckBox1.Value = True Then
    Set appWrd = CreateObject("Word.Application")
    appWrd.Visible = True
    Set docword = appWrd.documents.Open(chemin & modl)
    docword.Content.Find.Execute FindText:="Nq", ReplaceWith:=ordre & " / " & ann, Replace:=1
    docword.Content.Find.Execute FindText:="DateQ", ReplaceWith:=TextBox2.Value, Replace:=1
    docword.Content.Find.Execute FindText:="Orgn", ReplaceWith:=TextBox3.Value, Replace:=1
    docword.Content.Find.Execute FindText:="Thm", ReplaceWith:=TextBox6.Value, Replace:=1
    docword.Content.Find.Execute FindText:="Objt", ReplaceWith:=TextBox7.Value, Replace:=1
    docword.Tables(1).Columns(2).Cells(8).Range.Text = quest

    ' procédure d'enregistrement

    docword.SaveAs chemin & ann & "\" & nomrep & "\" & nomrep & ".docx" 'enregistre le fichier à la date du jour

    appWrd.Quit
End If

    Unload Me
Exit Sub
End If
Next i

End Sub

Le 22/08/2017 à 14:12

Je m'apprêtais à partir là-dessus aussi après avoir vu ton .doc mais comme tu as trouvé...

Le 22/08/2017 à 14:22

eriiic a écrit :
Je m'apprêtais à partir là-dessus aussi après avoir vu ton .doc mais comme tu as trouvé...

Ahah mais oui, avant de poser les questions faut chercher d'autres solutions moi qui voulais impérativement remplacer

J'ai tapé deux mots sur google et voilà.. Merci quand même !

Rechercher des sujets similaires à "string limite 255 caracteres"