Bonjour,
je possède un fichier pour un jeu online (pour ceux et celles qui me découvrent )
Ce fichier peut s'afficher en français, anglais ou espagnol, via une macro. A ce jour, au vu des données à traduire, la macro mouline 2 bonnes minutes. Est il possible de faire apparaitre l'avancement de ce calcul?
Je pensais à afficher une barre qui va de 0 à 100%... mais je n'y connais toujours rien en macro, et ne sais même pas si ma demande est faisable! Pour moi, ce n'est pas gênant, mais comme ce fichier est actuellement utilisé par environ 5000 joueurs, de tout âge, je pensais que ça pourrait être utile, afin de voir si c'est planté ou si ca mouline toujours...
Si c'est faisable, voila la macro utilisée :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LangueChoisie As String, Nomfeuille As String
Dim AddDest
Dim Languecolonne As Byte, PosSepar As Byte
Dim Nomcellule As String
Application.ScreenUpdating = False
If Target.Address = Range("Language").Address Then
Nomfeuille = ActiveSheet.Name
LangueChoisie = Target.Value
With Sheets("Textes")
.Select
.Range("IV1").Select
End With
Do
Selection.End(xlToLeft).Select
Loop Until ActiveCell.Value = LangueChoisie Or ActiveCell.Column = 1
Languecolonne = ActiveCell.Column
If Languecolonne = 1 Then
Selection.End(xlToRight).Select
Languecolonne = Languecolonne - ActiveSheet.Column
End If
ActiveSheet.Range("ColonneAdresse").Select
Languecolonne = Languecolonne - ActiveCell.Column
ActiveCell.Offset(1, 0).Select
Do While ActiveCell.Value <> ""
With ActiveCell
AddDest = .Value
PosSepar = WorksheetFunction.Search("!", AddDest, 1)
Nomfeuille = Left(AddDest, PosSepar - 1)
Nomcellule = Right(AddDest, Len(AddDest) - PosSepar)
If .Offset(0, Languecolonne).MergeCells Then
.Offset(0, Languecolonne)(1).Select
Selection.Copy
Else
.Offset(0, Languecolonne).Copy
End If
On Error GoTo Erreur
Application.EnableEvents = False
With Sheets(Nomfeuille)
.Select
.Range(Nomcellule).Select
.Paste
End With
Application.EnableEvents = True
Sheets("Textes").Select
If IsEmpty(.Offset(1, 0)) Then Application.CutCopyMode = False: Sheets("notice").Select: Exit Sub
.Offset(1, 0).Select
End With
Loop
With Sheets(Nomfeuille)
.Select
.Range("Language").Activate
End With
Else
End If
Application.CutCopyMode = False
Exit Sub
Erreur:
MsgBox "Erreur de procédure"
Application.EnableEvents = True
End Sub
Merci pour vos réponses!
Gigi