Texte aléatoire tous les lundi

[jokerfidelio]

Bonjour a tous

est t'il possible d'avoir une formule ou du vba,pour insérer un texte aléatoire tous les lundi de l'année ?
et mettre le résultat dans une autre feuille ?

merci d avance a tous

 

[STephane]

Re : Texte aléatoire tous les lundi

cette ligne se décompose en deux

dim iWeekno as integer Dim dMessage As String[/COLOR]

[COLOR=#333333]dim iWeekno as integer
Dim dMessage As String

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

Bonjour a tous

apres plusieurs essai positif tout etait fonctionnel ou presque !

mais depuis hier impossible de faire fonctionner le code correctement

j'ai pourtant controlé :

If dWeekday = 7 Then
pour que le resultats change a chaque ouverture de fichier, mais rien toujours le même texte !

et le dernier code non aleatoire ne fonctionne plus non plus :

Option Explicit
Private Sub WorkBook_Open()
Dim dWeekday As Double
dim iWeekno as integer Dim dMessage As String
' Obtenir le jour de la semaine / Get Week day
dWeekday = WorksheetFunction.Weekday(Date, 2)

' Obtenir le numéro de la semaine / Get week no (european ISO norm)
iWeekno=IsoWeekNum(now)
' Si c'est un lundi
If dWeekday = 2 Then
'   pour récupérer le message depuis une autre colonne, remplacer "A" par la colonne souhaitée.
'   to get the message from another column, replace "A" by the desired column letter.
   dMessage = WorksheetFunction.Index(Sheets("QUALITE").Columns("A").Range("A1:A52"), iWeekno)
    Sheets("CCT").Range("B16").Value = dMessage
End If
End Sub

Public Function IsoWeekNum(d1 As Date) As Integer
' Provided by Daniel Maher.
   Dim d2 As Long
   d2 = DateSerial(Year(d1 - Weekday(d1 - 1) + 4), 1, 3)
   IsoWeekNum = Int((d1 - d2 + Weekday(d2) + 5) / 7)
End Function

je suis perdu j'ai meme change de version excel mais toujours aucun resultat !!!

en piece jointe le fichier correspondant

 

[JCGL]

Re : Texte aléatoire tous les lundi

Bonjour à tous,

Pour compléter ou terminer le message de STephane :

dim iWeekno as integer Dim dMessage As String

doit être

Dim iWeekno as integer, dMessage As String

A+ à tous

 

[Si...]

Re : Texte aléatoire tous les lundi

salut

sans variable, à tester

Private Sub WorkBook_Open()
  If Weekday(Date) = 2 Then
    If Sheets("CCT").[B15] = "» essai 52" Then Sheets("CCT").[B15] = "» essai 1": Exit Sub
    Sheets("CCT").[B15] = Feuil2.[A:A].Find([B15], , , 1)(2, 1)
  End If
End Sub

Attention à la cellule variable (une fois B16, puis B15) et quand on arrive au bout !

 

[STephane]

Re : Texte aléatoire tous les lundi

ton fichier "Briefing v1" avec test aléatoire marche très bien chez moi (il m'a juste suffit de changer la condition testant le jour de la semaine à 3 pour Mercredi).

le seul problème, en cas de test aléatoire, serait si le fichier était ouvert plusieurs fois par jour.

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

ton fichier "Briefing v1" avec test aléatoire marche très bien chez moi (il m'a juste suffit de changer la condition testant le jour de la semaine à 3 pour Mercredi).

le seul problème, en cas de test aléatoire, serait si le fichier était ouvert plusieurs fois par jour.

OUI effectivement le fichier sera ouvert plusieurs par jour !
faut il prendre cette variable en considération ? et que faut il modifier pour cela ?

cdlt

 

[Si...]

Re : Texte aléatoire tous les lundi

Re (et merci pour le retour)

OUI effectivement le fichier sera ouvert plusieurs par jour !
faut il prendre cette variable en considération ? et que faut il modifier pour cela ?

C'est quand même à toi de le décider !

Pour un tirage aléatoire à chaque ouverture

Private Sub WorkBook_Open()
  Sheets("CCT").Select
  If Weekday(Now) = 5 Then _
    [B15] = [T].Rows(Application.RandBetween(1, 52))
End Sub

Pour un tirage aléatoire unique par jour (ouvertures multiples ou pas)

Private Sub WorkBook_Open()
  Sheets("CCT").Select
  If Weekday(Now) = 5 And [E7] = "" Then _
    [B15] = [T].Rows(Application.RandBetween(1, 52)): [E7] = " "
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  [E7] = "" 
End Sub

T est le nom du tableau des textes et [E7] car cette cellule est masquée par l'image.
J'ai mis 5 (pour tester ce jour (jeudi).

Attention, le résultat ne sera pas le même si on ne veut pas de doublon au tirage (autre programmation dans ce cas).

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

Re (et merci pour le retour)

C'est quand même à toi de le décider !

Pour un tirage aléatoire à chaque ouverture

Private Sub WorkBook_Open()
  Sheets("CCT").Select
  If Weekday(Now) = 5 Then _
    [B15] = [T].Rows(Application.RandBetween(1, 52))
End Sub

Pour un tirage aléatoire unique par jour (ouvertures multiples ou pas)

Private Sub WorkBook_Open()
  Sheets("CCT").Select
  If Weekday(Now) = 5 And [E7] = "" Then _
    [B15] = [T].Rows(Application.RandBetween(1, 52)): [E7] = " "
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  [E7] = "" 
End Sub

T est le nom du tableau des textes et [E7] car cette cellule est masquée par l'image.
J'ai mis 5 (pour tester ce jour (jeudi).

Attention, le résultat ne sera pas le même si on ne veut pas de doublon au tirage (autre programmation dans ce cas).

Merci a toi Si...

Apres plusieurs essais, pour aller au plus simple :

- a chaque ouverture du fichier, tous les lundi de l'année 1 message en (B15)
- ce message visible toute la semaine jusqu'au lundi suivant (même avec ouverture multiples toute la semaine)
- EX : message dans cellule A46 ----> message pour la semaine 46 et ainsi de suite jusque semaine 52