Format de cellule automatique

[TRANSPLANT69]

Bjr,

Je dois gerer plusieurs devises dans un meme tableau, et je souhaiterai automatiser le format "devise" d'une cellule en fonction de la selection effectuee dans une liste pre-etablie dans une autre cellule (voir fichier "Extrait.xls" joint)

Merci par avance.

 

[Hulk]

Re : Format de cellule automatique

Hello,

Si j'ai bien compris, colle le code ci-dessous dans la feuille (Alt+F11)

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim x As Range
    
    Set x = Range("B3:B" & Range("B65536").End(xlUp).Row)
    
    For Each x In x
        If x = "EURO" Then
            x.Offset(0, 1).NumberFormat = "[$€-2] #,##0.00"
        ElseIf x = "RmB" Then
            x.Offset(0, 1).NumberFormat = "[$Rmb] #,##0.00"
        ElseIf x = "CAD" Then
            x.Offset(0, 1).NumberFormat = "[$CAD] #,##0.00"
        ElseIf x = "JPY" Then
            x.Offset(0, 1).NumberFormat = "[$JPY] #,##0.00"
        ElseIf x = "USD" Then
            x.Offset(0, 1).NumberFormat = "[$USD] #,##0.00"
        ElseIf x = "HKD" Then
            x.Offset(0, 1).NumberFormat = "[$HKD] #,##0.00"
        ElseIf x = "GBP" Then
            x.Offset(0, 1).NumberFormat = "[$GBP] #,##0.00"
        Else
            x.Offset(0, 1).NumberFormat = "General"
        End If
    Next x
    
End Sub

Il y a sûrement plus court, mais ça le fait.

Cdt, Hulk.

 

[kllmoon]

Re : Format de cellule automatique

Si tes valeurs dans ta liste déroulante respectent les mêmes noms de valeurs que Excel, tu peux utiliser

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim x As Range
    Dim y As String
    y = Target.Value
    Set x = Range("B3:B" & Range("B65536").End(xlUp).Row)
    
    For Each x In x
        If x = " " Then
        x.Offset(0, 1).NumberFormat = "General"
           
        Else
             x.Offset(0, 1).NumberFormat = "[$" & y & "] #,##0.00"
        End If
    Next x
    
End Sub

Sinon le code de Hulk fonctionne bien.

 

[ROGER2327]

Re : Format de cellule automatique

Bonjour à tous

Un autre (format "comptabilité") :

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim uPlg As Object, oCel As Range, tf As Boolean
   Do
      On Error Resume Next
      With Range("B2").Offset(0, -tf)
         Set uPlg = Intersect(Target, .Resize(Cells(Rows.Count, .Column).End(xlUp).Row - .Row, 1).Offset(1, 0))
         If Not uPlg Is Nothing Then
            For Each oCel In uPlg.Cells
               oCel.Offset(0, 1 + tf).NumberFormat = aaa(CStr(oCel.Offset(0, tf).Value))
            Next oCel
         End If
      End With
      On Error GoTo 0
      tf = Not tf
   Loop While tf
End Sub

Private Function aaa(s As String) As String
Dim UM
   UM = Array("EURO", "RmB", "USD", "JPY", "GBP", "CAD", "HKD")
   Select Case s
      Case UM(0): s = "EUR"
      Case UM(1): s = "RmB"
      Case UM(2): s = "USD"
      Case UM(3): s = "JPY"
      Case UM(4): s = "GBP"
      Case UM(5): s = "CAD"
      Case UM(6): s = "HKD"
      Case Else: s = ""
   End Select
   If s = "" Then
      aaa = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
   Else
      aaa = "_-* #,##0.00 [$" & s & "]_-;-* #,##0.00 [$" & s & "]_-;_-* ""-""?? [$" & s & "]_-;_-@_-"
   End If
End Function[/B][/COLOR]

ROGER2327
#2222

 

[TRANSPLANT69]

Re : Format de cellule automatique

Merci. Je vais essayer mais etant debutant (ou presque) je ne vois pas ou inserer ce code et comment ce fait le lien avec ma feuille.

 

[Pierrot93]

Re : Format de cellule automatique

Bonjour à tous,

code à copier dans le module de la feuille concernée => click droit sur l'onglet => visualiser le code et tu le colles...

attention, un seul code événement "Worksheet_Change" par feuille...

bonne journée
@+