XL 2016 VBA "traduction" de validation de données

[Turgon]

Bonjour à tous, et excusez-moi par avance si le sujet a déjà été posté, mais je ne l'ai pas trouvé sur le fil de discussions.

J'ai hérité d'une macro, qui, comme le titre l'indique, vise à traduire toutes mes validations de données dans une feuille de travail.
-Une première partie, qui collecte toutes les validations de données et me les affiche dans un tableau, sur un feuillet qui se crée, nommé "messages". Texte ci-dessous:


Sub GetMessages()
'
Dim i As Integer
Dim myM As Worksheet
Dim myC As Range
Dim myRow As Long
Dim myCalc As XlCalculation
With Application
.DisplayAlerts = False
.EnableEvents = False
myCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set myM = Worksheets.Add(before:=Worksheets(1))
myM.Name = "Messages"
myM.Cells(1, 1).Value = "Address"
myM.Cells(1, 2).Value = "Existing Input Title"
myM.Cells(1, 3).Value = "Existing InputMessage"
myM.Cells(1, 4).Value = "Existing Error Title"
myM.Cells(1, 5).Value = "Existing Error Message"
myM.Cells(1, 6).Value = "Translated Input Title"
myM.Cells(1, 7).Value = "Translated InputMessage"
myM.Cells(1, 8).Value = "Translated Error Title"
myM.Cells(1, 9).Value = "Translated Error Message"
myM.Rows(1).Cells.WrapText = True
On Error GoTo NoValidation
For i = 2 To Worksheets.Count
For Each myC In Worksheets(i).Cells.SpecialCells(xlCellTypeAllValidation)
myRow = myM.Cells(Rows.Count, 1).End(xlUp).Row + 1
myM.Cells(myRow, 1).Value = myC.Address(False, False, xlA1, True)
If myC.Validation.ShowInput Then
myM.Cells(myRow, 2).Value = myC.Validation.InputTitle
myM.Cells(myRow, 3).Value = myC.Validation.InputMessage
End If
If myC.Validation.ShowError Then
myM.Cells(myRow, 4).Value = myC.Validation.ErrorTitle
myM.Cells(myRow, 5).Value = myC.Validation.ErrorMessage
End If
Next myC
NoValidation:
Next i
With myM.Cells
.ColumnWidth = 16.43
.EntireRow.AutoFit
End With
With myM.Range("A1").CurrentRegion
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.Calculation = myCalc
End With
End Sub
--------------------------------------------------------------------------------------------------------------------------------Jusqu'ici tout va bien, la macro marche.
J'ai ensuite traduit chaque validation de données (titre d'entrée, message d'entrée, titre d'erreur, message d'erreur) en utilisant un autre feuillet ou j'ai copié le tableau obtenu, retiré les duplicats (j'avais 1700+ traductions à faire sinon), traduit, puis utilisé un VLOOKUP dans le tableau original.

-Deuxième macro, qui est censée remplacer le texte existant par sa traduction.

Sub UpdateMessages()
Dim myM As Worksheet
Dim i As Long
Set myM = Worksheets("Messages")
For i = 2 To myM.Cells(Rows.Count, 1).End(xlUp).Row
With Range(myM.Cells(i, 1).Value)
If myM.Cells(i, 2).Value <> "" Then .Validation.InputTitle = myM.Cells(i, 6).Value
If myM.Cells(i, 3).Value <> "" Then .Validation.InputMessage = myM.Cells(i, 7).Value
If myM.Cells(i, 4).Value <> "" Then .Validation.ErrorTitle = myM.Cells(i, 8).Value
If myM.Cells(i, 5).Value <> "" Then .Validation.ErrorMessage = myM.Cells(i, 9).Value
End With
Next i
End Sub
--------------------------------------------------------------------------------------------------------------------------------Et là erreur 400. En exécutant la macro avec F8, j'obtiens une erreur 1004: "application defined or object defined error" au niveau de la ligne rouge.

Débutant en VBA, je viens vers vous avec comme espoir:

1) de faire marcher ma macro

2) de comprendre pourquoi celle-ci ne marche pas.

Bonne journée, et merci d'avance!

 

[Turgon]

Bon ben ca marche impeccablement bien, un grand merci. Ya juste une partie des messages de validation qui sont coupés, mais je suppose que je peux le régler dans la macro (ca correspond à 10,20,32 et 20 c'est ca?)

Encore un grand merci pour ton effort, je vois bien que c'était vraiment pas clair au début. En gros, le problème était les 4 pauvres cellules qui n'avaient pas de traduction, ou la moindre cellule vierge blanche posait problème?

Bonne soirée, et bon week-end!

 

[Turgon]

Bonjour, je me permets de up ce topic. La macro que vgendron avait créée marchait parfaitement jusqu'à ce que je l'applique au même fichier légèrement modifié, et là la macro rencontre une erreur et ne génère plus les informations de Validation à partir d'un certain point.

Pour résumer, j'ai la macro suivante, qui est censée générer sur un feuillet séparé tous les "validation data" de mon fichier (le titre, le message, le titre du message d'erreur, et le texte d'erreur, et ce pour chaque cellule de chaque feuillet du fichier): C'est la partie "GetMessages".
Puis, une fois ces messages traduits (par moi), remplacer les "validation data" pour chaque cellule de mon fichier par leur traduction: c'est la fonction UpdateMessages.

Question: Est-ce-que quelqu'un a une idée du pourquoi la macro plante (erreur 400), et comment je pourrais la fix?

La macro que j'utilise est ci-dessous et le fichier en copie.

En vous souhaitant une bonne journée,
-----------------------------------------------------------------------------------------------------------------------
Sub GetMessages()
'
Dim i As Integer
Dim myM As Worksheet
Dim myC As Range
Dim myRow As Long


With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
End With


If Not (FeuilleExiste("Messages")) Then

Set myM = Worksheets.Add(before:=Worksheets(1))
myM.Name = "Messages"
myM.Cells(1, 1).Value = "Address"
myM.Cells(1, 2).Value = "Existing Input Title"
myM.Cells(1, 3).Value = "Existing InputMessage"
myM.Cells(1, 4).Value = "Existing Error Title"
myM.Cells(1, 5).Value = "Existing Error Message"
myM.Cells(1, 6).Value = "Translated Input Title"
myM.Cells(1, 7).Value = "Translated InputMessage"
myM.Cells(1, 8).Value = "Translated Error Title"
myM.Cells(1, 9).Value = "Translated Error Message"
myM.Rows(1).Cells.WrapText = True
Else
Set myM = Sheets("Messages")
With myM
.UsedRange.Offset(1, 0).Clear
End With
End If



For i = 2 To Worksheets.Count 'chez moi. ca plante sur la dernière feuille.. le On error ne semble rien faire...
On Error GoTo NoValidation
For Each myC In Worksheets(i).Cells.SpecialCells(xlCellTypeAllValidation)
myRow = myM.Cells(Rows.Count, 1).End(xlUp).Row + 1
myM.Cells(myRow, 1).Value = myC.Address(False, False, xlA1, True)
If myC.Validation.ShowInput Then
myM.Cells(myRow, 2).Value = myC.Validation.InputTitle
myM.Cells(myRow, 3).Value = myC.Validation.InputMessage
End If
If myC.Validation.ShowError Then
myM.Cells(myRow, 4).Value = myC.Validation.ErrorTitle
myM.Cells(myRow, 5).Value = myC.Validation.ErrorMessage
End If
Next myC
NoValidation:
Next i

formule = "=SIERREUR(RECHERCHEV(B2;Translation!B$1:$I$60;5;FAUX);"""")"
Range("F2").FormulaLocal = formule
Range("F2:I2").FillRight
Range("F2:I2").Resize(myRow - 1).FillDown
With myM.Cells
.ColumnWidth = 16.43
.EntireRow.AutoFit
End With

With myM.Range("A1").CurrentRegion
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub

Sub UpdateMessages()
Dim myM As Worksheet
Dim tablo() As Variant
Dim i As Long
Set myM = Worksheets("Messages")
With myM
fin = .Range("A" & .Rows.Count).End(xlUp).Row
tablo = Range("A2:I" & fin).Value
End With
For i = LBound(tablo, 1) To UBound(tablo, 1)

feuille = Split(Split(tablo(i, 1), "]")(1), "'")(0)
cellule = Split(tablo(i, 1), "!")(1)

With Sheets(feuille).Range(cellule).Validation
If tablo(i, 2) <> "" Then .InputTitle = Left(Trim(tablo(i, 6)), 10)
If tablo(i, 3) <> "" Then .InputMessage = Left(tablo(i, 7), 20)
If tablo(i, 4) <> "" Then .ErrorTitle = Left(tablo(i, 8), 32) 'pour le message d'erreur, il y a 32 caractères maximum autorisés
If tablo(i, 5) <> "" Then .ErrorMessage = Left(tablo(i, 9), 20)
End With
Next i

End Sub

Function FeuilleExiste(NomFeuille As String)
FeuilleExiste = False
For Each ws In ActiveWorkbook.Sheets
If ws.Name = NomFeuille Then
FeuilleExiste = True
Exit For
End If
Next ws

End Function

-----------------------------------------------------------------------------------------------