Majuscule en Gras et Rouge Résolu/Fermé

Question

Bonjour a tous et toutes, Forum bonjour,

Dans les cellules A1/A2 s'affiche exactement sous cette forme les deux messages ci-dessous

Cellule A1       Mardi 12 Mai 2009                                  
Cellule A2       132 ième Jour de l´année   Semaine:20      

Majuscule déja mise en A1 et  A2

je souhaiterai SVP en VBA mettre en Rouge et gras la première lettre du jour et du mois (M)ardi et (M)ai pour A1

ainsi que (J)our et (S)emaine pour A2

Merci beaucoup a vous et de votre temps   Excel 2007 et Vista

Bonne journée       Raymond

Mike-31 · Answer

Salut,

Pour commencer tu devrais mettre tes statuts en résolu des tes discussions antérieures, et comme je te l'ai dégalement conseillé, il serait bien que tu te déclares membre de commen ça marche.

Pour repondre à ta quetion, en VBA c'est possible

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mike-31 · Answer

Re,

D'ou l'intérêt d'étre membre, clic sur le triangle et demande à un modérateur de mettre le statut en résolu pour toi et on continu sur l'autre discussion

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mike-31 · Answer

Re,

Pour la première lettre dans la cellule, pas de problème

Sub Macro5()
    With [A1].Characters(Start:=1, Length:=1).Font
        .FontStyle = "Gras"
        .ColorIndex = 3
    End With
    With [A2].Characters(Start:=1, Length:=1).Font
        .FontStyle = "Gras"
        .ColorIndex = 3
    End With
End Sub

Pour les suivantes, le problème est qu'elles ne sont jamais a la même place, je m'absente et vois ça ce soir

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Bidouilleu_R · Answer

Bonjour,

Bonjour,
je ne pense pas que Mike-31 est laissé tomber.....
Faut être gentil ... c'est une qualité qui est rare et donc qui enrichit.


pour ton affaire je ferai comme ça!
j'ai supposé que tu avais une date donc j'utilise  x = Format([A1].Value, "dddd dd mmmm yyyy")
mais si tu as une chaine de texte tu mets x=[A1].value

j'ai fais le premier c'est le même principe pour le deuxième voir plus facile.


Sub GrasRouge()
Dim depart As Integer
Dim x As String
x = Format([A1].Value, "dddd dd mmmm yyyy")
'ou
' x=[A1].value ' si chaine texte
depart = 1  ' pour la position des charactères


    With [A1].Characters(Start:=depart, Length:=1).Font
        .FontStyle = "Gras"
        .ColorIndex = 3
    End With
    nbspc = 0    ' pour compter les espaces
    For depart = 1 To Len(x)
    If Mid(x, depart, 1) = " " Then
        nbspc = nbspc + 1
    End If
    If nbspc > 1 Then Exit For
    Next
    depart = depart + 1 ' on avance de 1 charactère après le deuxième espace
    
    
    ' on applique le format...
    With [A1].Characters(Start:=depart, Length:=1).Font
        .FontStyle = "Gras"
        .ColorIndex = 3
    End With



End Sub

Mike-31 · Answer

Salut,

Merci Bidouilleu_R d'avoir pris le relai, et excuse dudulray un petit imprévu, sans vouloir ajouter une couche à ce qui à été dit, il faut savoir que nous sommes bénévoles, et sur un forum il y a toujours un ami qui apporte son concours dans les limites de ses connaissances et de sa disponibilité

si le code de notre ami Bidouilleu_R ne rempli pas tes attentes regardes celui que je te propose

Sub essai()
    Dim i&
    Dim F As Range
    For Each F In [A1:F10]  'Plage à traiter
    F.Characters(1, 1).Font.Bold = True
    F.Characters(1, 1).Font.ColorIndex = 3
    For i = 2 To Len(F)
    Select Case Asc(Mid(F, i, 1))
    Case 65 To 90
    If Asc(Mid(F, i - 1, 1)) = 32 Then
    F.Characters(i, 1).Font.Bold = True
    F.Characters(i, 1).Font.ColorIndex = 3
    End If
    End Select
    Next
    Next
End Sub


A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mike-31 · Answer

RE,

si ton fichier ne contient pas de données confidentielles mets le sur le forum avec ce lien

https://www.cjoint.com/

ou mets le lien généré sur un message privé en cliquant sur mon pseudo et message privé

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Bidouilleu_R · Answer

Salut les gars,

j'avais essayé de faire simple.

mais je trouve ton code très interessant, du moins pas classique.
je crois que je vais te le piquer, oui c'est dit je le pique. ... et merci.

Bon week end.

Mike-31 · Answer

Re,

Je vais manger si non ma moitié va me charpir et je vois cela après

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mike-31 · Answer

Re,

places ce codes dans un module et associes la macro test à un bouton


Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Sub Test()
    Dim X, Z, O As Byte
    Dim c As Range: Dim D As Range: Dim i
    [A1].Font.ColorIndex = 0
    [A1].Font.Bold = False
    [A1] = Application.Proper(Format(Date, "dddd dd mmmm yyyy "))
    Set c = [A1]
    For i = 1 To 40 'Durée de rotation de la date
    c = Right(c, Len(c.Value) - 1) + Left(c, 1)
    Sleep 150 'Vitesse de rotation
    Next i
    [A1] = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
    Majuscule_En_Gras
    Application.Wait (Now + TimeValue("00:00:03")) 'Tempo de 3 secondes
    [A2].Font.ColorIndex = 0
    [A2].Font.Bold = False
    Set D = [A2]
    For i = 1 To 40 'Durée de rotation semaine et jour
    D = Right(D, Len(D.Value) - 1) + Left(D, 1)
    Sleep 150 'Vitesse de rotation
    Next i
    [A2] = "Semaine: " & DatePart("ww", Date, vbMonday) & " " & _
    DatePart("y", Date, vbMonday) & " ième Jour de l" & Chr(180) & "année"
    Majuscule_En_Gras
End Sub

Sub Majuscule_En_Gras()
    Dim i&
    Dim c As Range
    For Each c In [A1:F10]  'Plage à traiter
    c.Characters(1, 1).Font.Bold = True
    c.Characters(1, 1).Font.ColorIndex = 3
    For i = 2 To Len(c)
    Select Case Asc(Mid(c, i, 1))
    Case 65 To 90
    If Asc(Mid(c, i - 1, 1)) = 32 Then
    c.Characters(i, 1).Font.Bold = True
    c.Characters(i, 1).Font.ColorIndex = 3
    End If
    End Select
    Next
    Next
End Sub


A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mytå · Answer

Salut le forum

Raymond, tu as la même solution de l'autre côté

Option Explicit
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Sub Tst()

Dim I As Byte
Dim C As Range

[A1] = Application.Proper(Format(Date, "dddd dd mmmm yyyy")) & " "
Maj_Rouge ([A1])

[A2] = "La " & DatePart("y", Date, vbMonday) & " ième Journée" & _
   " de la " & DatePart("ww", Date, vbMonday) & " ième Semaine. "
Maj_Rouge ([A2])

'*** Code pour le défilement du texte des cellules A1 et A2 ***

Sleep 1000

Set C = [A1]
For I = 1 To Len([A1]) * 2
C = Right(C, Len(C.Value) - 1) + Left(C, 1)
Maj_Rouge ([A1])
Sleep 100
Next I

Sleep 1000

Set C = [A2]
For I = 1 To Len([A2]) * 2
C = Right(C, Len(C.Value) - 1) + Left(C, 1)
Maj_Rouge ([A2])
Sleep 100
Next I

Set C = Nothing

End Sub

Sub Maj_Rouge(Cellule As Range)
Dim I As Byte
For I = 1 To Len(Cellule)
With Cellule
  With .Characters(I).Font
    .FontStyle = "Normal"
    .ColorIndex = xlAutomatic
  End With
    Select Case Asc(Mid(.Value, I, 1))
        Case 65 To 90
            With .Characters(I).Font
                .FontStyle = "Gras"
                .ColorIndex = 3
            End With
    End Select
  With .Characters(I + 1).Font
    .FontStyle = "Normal"
    .ColorIndex = xlAutomatic
  End With
End With
Next I
End Sub

Mytå

Mike-31 · Answer

Salut,

Il doit y avoir un problème autre que le code par lui même, testes le fichier joint à récupérer avec ce lien et tiens nous au courant

https://www.cjoint.com/?fpj0hzCaX0

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mike-31 · Answer

Re,

Pour la cure d'amaigrissement du code, on pourrait encore le concentrer un petit peu, pour ta cure, autrefois les jeunes que nous étions disaient des gens corpulent ils sont gros, plus tard avec l’age nous disions ils ont un peu d’embonpoint et maintenant que l’âge nous rattrape il vaut mieux dire nous sommes confortable, rassure toi il vaut mieux faire envie que pitié.

Pour répondre à tes questions, il n’est pas possible de garder le format du texte gras et rouge de certaines lettres lors du défilement, ou il est tout gras ou tout rouge, mais l’ensemble du texte est identique.
J’ai une petite idée là-dessus, si j’arrive à faire quelque chose, je te le dirai

Pour ta deuxième question, lorsqu’on démarre un code macro, il est prioritaire et ne s’arrête qu’a la fin ou il faut prévoir dans le code une condition d’arrêt qui n’est pas ce qu’il y a de mieux.
Par contre on peut ajouter au code un déclenchement automatique toutes les x minutes et dans c’est intervalle il est possible de travailler sur la feuille ou d’arrêter le code


A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mike-31 · Answer

Re,

Ton lien est vide, pour envoyer une pièce jointe, cliques sur le lien ci-dessous

https://www.cjoint.com/
Fais parcourir, sélectionnes le fichier à envoyer, clic sur créer le lien/Autoriser l’accès et colle le lien généré en haut de ta feuille sur un post.

Si je comprends bien tu souhaites que le défilement soit cyclique toutes les X minutes avec possibilité d’arrêt à la fin d’un cycle

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mike-31 · Answer

Re,

J'ai vu le code qui t’a été proposé, il est complexe et marche bien et je connais bien l'intervenant que j’apprécie, mais par respect et comme tous nous le ferions, je ne peux modifier un code proposé sur un autre forum, il est la propriété de son auteur, contraire à la charte des forum et loi informatique

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mike-31 · Answer

Re,

C'est normal, pour faire clignoter une image ou une cellule etc ... comme pour le défilement on se sert du cadencé et donc l'avancement est saccadé et plus la taille est importante et plus c'est visible

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Mike-31 · Answer

Salut,

Le peu que j'ai regardé ce code, il n'est pas possible d'arrêter le déroulement de la macro ou de changer de feuille, comme je te l’ai déjà dit le déroulement d’une macro est prioritaire ou dans le code il faut prévoir des accès.
Le seul moyen est de mettre en erreur le code en faisant Echap et répondre Fin parce que si tu réponds Débogage, le code ce verrouille


A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)

Majuscule en Gras et Rouge

16 réponses

Discussions similaires