XL 2013 comment copier une mise en forme automatiquement avec une formule ?

[cd92600]

Bonjour à tous.
je ne suis pas expert en Excel mais grâce à vos fichiers, discussions, j'ai pu créé un fichier Excel qui me permet de traduire des phrases comme pour Google translate.
Après je me suis dit :"tiens si j'essayai de faire la même chose avec un tableau".
comme idée, je me suis dit que j'insérerai dans un onglet un tableau en Anglais et dans un autre onglet automatiquement le même tableau serait traduit.

j'ai donc créé une formule qui me permet de traduire chaque cellule. =traduire('insérer tableau US'!A2;$A$1;$B$1)
Celle ci fonctionne.

Maintenant mon problème est le suivant. visuellement le tableau US mis dans le 1er onglet ne ressemble absolument pas au 2ème onglet.
Comment faire pour que la cellule A2 copie le contenu de la cellule A2 du 1er onglet onglet et copie également la mise en forme ?
suis je obligé de faire une macro ?
si oui laquelle ?
Si non que dois je faire pour qu'automatiquement la mise en forme se fasse et qu'en plus ma formule de traduction se passe aussi ?

Je vous remercie par avance pour vos idées et votre aide.

 

[fanch55]

Bonjour,
Je suppose que quand vous dites mise en forme, vous entendez également les largeurs et hauteurs de lignes ?
Le code à exécuter ci-dessous devrait convenir :

Sub CopyFormat()
    Save_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.Calculate
        Set LastCell = Worksheets("insérer tableau US").UsedRange.SpecialCells(xlCellTypeLastCell)
        Worksheets("insérer tableau US").Range("A2", LastCell).Copy
        Worksheets("traduction du tableau US").[A2].PasteSpecial Paste:=xlPasteFormats
        Worksheets("traduction du tableau US").[A2].PasteSpecial Paste:=xlPasteColumnWidths
        
        For Rw = 2 To Worksheets("insérer tableau US").UsedRange.Rows.Count
            Worksheets("traduction du tableau US").Rows(Rw).RowHeight = Worksheets("insérer tableau US").Rows(Rw).RowHeight
        Next
        
        
    Application.Calculation = Save_Calculation

End Sub

 

[cd92600]

Bonjour
Merci pour le code c'est super sympa de votre part d'avoir pris du temps à me répondre.
Et oui lorsque je disais mise en forme, je parlais également des largeurs et hauteurs de lignes.

Petite question, on est obligé de passer par du code, cela n'est pas possible avec une formule ?

Bonjour,
Je suppose que quand vous dites mise en forme, vous entendez également les largeurs et hauteurs de lignes ?
Le code à exécuter ci-dessous devrait convenir :

Sub CopyFormat()
    Save_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.Calculate
        Set LastCell = Worksheets("insérer tableau US").UsedRange.SpecialCells(xlCellTypeLastCell)
        Worksheets("insérer tableau US").Range("A2", LastCell).Copy
        Worksheets("traduction du tableau US").[A2].PasteSpecial Paste:=xlPasteFormats
        Worksheets("traduction du tableau US").[A2].PasteSpecial Paste:=xlPasteColumnWidths
        
        For Rw = 2 To Worksheets("insérer tableau US").UsedRange.Rows.Count
            Worksheets("traduction du tableau US").Rows(Rw).RowHeight = Worksheets("insérer tableau US").Rows(Rw).RowHeight
        Next
        
        
    Application.Calculation = Save_Calculation

End Sub

 

[fanch55]

Si vous ne voulez pas passer pas par une macro ,
il faut dupliquer votre feuille source
et changer chaque cellule de la copie par une formule du genre =@traduire(cellule de la feuille source;....) .
Cela sous entend que la feuille source ne change jamais de format ....

De toutes façons, vous devrez conserver l'extension xlsm à cause de la fonction traduire .

 

[Dranreb]

Bonjour.
Pour m'en tenir à l'intitulé de la discussion, Une fonction perso écrite en VBA ne peut rien renvoyer d'autre que la valeur que la formule qui l'utilise peut produire. Mais elle peut enregistrer quelque chose dans une Collection VBA, qu'une Private Sub WorkBook_SheetCalculate dans ThisWorkbook peut très bien explorer en vue d'y trouver une consigne de changer le format d'une cellule, laissée par la fonction.

 

[Dranreb]

Ceci fonctionne par exemple, bien que ce soit long :
Dans Module1 :

Option Explicit
Function TRADUIRE(ByVal CelSrc As Range, ByVal Origine As String, ByVal Destination As String)
    Dim Texte As String, URL As String, CelAC As Range
    Texte = CelSrc.Value
    URL = "https://translate.google.com/m?sl=" & Origine & "&tl=" & Destination & " &q=" & WorksheetFunction.EncodeURL(Texte)
    URL = LCase(URL)
    URL = Replace(URL, "zh-tw", "zh-TW")
   
    Dim HTML As String
    HTML = WorksheetFunction.WebService(URL)
   
    Dim baliseDebut As String
    baliseDebut = "<div class=""result-container"">"
   
    Dim positionDepart As Integer
    positionDepart = InStr(HTML, baliseDebut)
   
    Dim positionFin As Integer
    positionFin = InStr(positionDepart, HTML, "</div>")
   
    Texte = Mid(HTML, positionDepart, positionFin - positionDepart)
    Texte = Replace(Texte, baliseDebut, "")
   
    Texte = Replace(Texte, "&#39;", "'")
   
    TRADUIRE = Texte
   Set CelAC = Application.Caller
   ThisWorkbook.Consigne CelAC, CelSrc
   End Function

Dans ThisWorkbook :

Option Explicit
Private Cln As New Collection
Public Sub Consigne(ByVal CelCbl As Range, ByVal CelSrc As Range)
   Cln.Add CelCbl
   Cln.Add CelSrc
   End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
   Dim CelCbl As Range, CelSrc As Range
   Do While Cln.Count > 1
      Set CelCbl = Cln(1): Cln.Remove 1
      Set CelSrc = Cln(1): Cln.Remove 1
      CelSrc.Copy
      CelCbl.PasteSpecial xlPasteFormats
      CelCbl.EntireRow.RowHeight = CelSrc.EntireRow.RowHeight
      CelCbl.EntireColumn.ColumnWidth = CelSrc.EntireColumn.ColumnWidth
      Loop
   End Sub

 

[fanch55]

Salut @Dranreb ,
Je ne pensais pas que le demandeur voulait que la fonction agisse sur le format dans chaque feuille où elle est appelée, d'autant plus que les colonnes ou lignes fusionnées ne sont pas rétablies ...