Concaténer format [h]:mm:ss

[Paulair]

Bonjour,

J'ai un problème pour concaténer une date au format "[h]:mm:ss".

En effet avec le code ci-dessous, j'obtient dans mes cellules des résultats de type :
:12:00
2
Au lieu de
22:50:00
2

Sub Conca()

    Dim Dur, Pourcent As Integer

        For X = 2 To 8
                Sheets(Cells(3, X).Value).Activate
                Dur = Cells(2, 2).Value 
                Sheets("Ensemble").Activate
                Pourcent = 2
                Cells(4, X) = Format(Dur, "[h]:mm:ss") & "    " & Pourcent
        Next X

End Sub

Dans un 2eme temps une fois ce problème résolus j'aimerai savoir si il est possible de mettre au format gras italique (FontStyle = "Gras Italique"? ) et de couleur bleu (.ColorIndex = 11) une partie du contenu de la cellule, plus précisément la valeur Pourcent.

Merci d'avance pour votre aide.

PS : pour la concaténation je ne peut utiliser le format "hh:mm:ss" car c'est un total d'heure qui dépasse de temps en temps la valeur 24:00:00, soit :
Avec [h]:mm:ss 25:15:12
Avec hh:mm:ss 1:15:12

 

[Catrice]

Re : Concaténer format [h]:mm:ss

Bonjour,

Je ne sais pas trop expliquer le probleme, mais voici une façon de le contourner :

Une version simplifiée qui évite les Activate et Select :

Sub Conca2()
Pourcent = "2%"
For X = 2 To 3 'Adapté pour tester
    Dur = Sheets(Cells(3, X).Value).Cells(2, 2).Value
    Sheets("Ensemble").Cells(4, X) = IIf(Dur >= 1, Int(Dur) * 24 & Right(Format(Dur - Int(Dur), "h:mm:ss"), 6), Format(Dur, "hh:mm:ss")) & "    " & Pourcent
Next X
End Sub

Edit : Version corrigée conformément à la remarque du Post #3

 

[Paulair]

Re : Concaténer format [h]:mm:ss

Merci je vais tester ça de suite 🙂

Edit :
Voilà ce que j'obtiens
0:50:00
au lieu de
22:50:50
soit en format standard
0.95138889
Par contre pour la valeur
24:15:00 le résultat est bon
La piste de travail est très intéressante.
En mettant une condition de type, si la valeur est supérieur à 1 je calcul par ce biais, sinon je passe ma valeur au format hh:mm:ss, je pense que ça sera bon.

Merci encore.

 

[Catrice]

Re : Concaténer format [h]:mm:ss

Re,

La vesion qui met en Gras :

Sub Conca()
Pourcent = 2
PourForm = Format(Pourcent / 100, "0%")
For X = 2 To 3 'Adapté pour tester
    Dur = Sheets(Cells(3, X).Value).Cells(2, 2).Value
    With Sheets("Ensemble").Cells(4, X)
        .Value = IIf(Dur >= 1, Int(Dur * 24) & Right(Format(Dur - Int(Dur), "h:mm:ss"), 6), Format(Dur, "hh:mm:ss")) & "    " & PourForm
        With .Characters(Start:=Len(.Value) - Len(PourForm) + 1, Length:=Len(PourForm)).Font
            .FontStyle = "Gras"
            .ColorIndex = 5
        End With
    End With
Next X
End Sub

Voir le fichier joint

Edit : Version corrigée conformément à la remarque du Post #3
Edit2 : Version corrigée (et fichier) en tenant compte de la remarque du Post #6

 

[Paulair]

Re : Concaténer format [h]:mm:ss

Excellent merci bien, je vais Re Tester ça de suite 😛

Edit :
Parfait, je vais beaucoup progressé avec ce type de code, plein de truc à comprendre, pour au final faire évoluer positivement ma manière de coder 😎


Merci pour tout (rapidité, clarté....) 🙂

Bonne journée et bon week

 

[Paulair]

Re : Concaténer format [h]:mm:ss

Le code est énorme est va beaucoup me servir. juste une petite modif pour cloturer :

Changer

[COLOR="DarkRed"]Int(Dur) * 24 [/COLOR]

(25:25:00 donne 24:25:00)

Par

[COLOR="DarkGreen"]Int (Dur*24)  [/COLOR]

(25:25:00 donne 25:25:00)



Pour au final :

Sub Conca()
Pourcent = 2
PourForm = Format(Pourcent / 100, "0%")
For X = 2 To 3 'Adapté pour tester
    Dur = Sheets(Cells(3, X).Value).Cells(2, 2).Value
    With Sheets("Ensemble").Cells(4, X)
        .Value = IIf(Dur >= 1, [COLOR="DarkRed"][B]Int(Dur * 24) [/B][/COLOR]& Right(Format(Dur - Int(Dur), "h:mm:ss"), 6), Format(Dur, "hh:mm:ss")) & "    " & PourForm
        With .Characters(Start:=Len(.Value) - Len(PourForm) + 1, Length:=Len(PourForm)).Font
            .FontStyle = "Gras"
            .ColorIndex = 5
        End With
    End With
Next X
End Sub

 

[Catrice]

Re : Concaténer format [h]:mm:ss

Re,

super, j'ai modifié le fichier du Post #4 pour ceux qui veulent tester.