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

 

[GerardCalc]

Re : Texte aléatoire tous les lundi

Bonsoir,

=SI(JOURSEM(AUJOURDHUI();2)=1;INDEX('A L AFFICHE'!A1:A52;ALEA.ENTRE.BORNES(1;52));"")

A+

 

[CBernardT]

Re : Texte aléatoire tous les lundi

Bonjour jokerfidelio, GerardCalc,

Une version en VBA.

Mettre la macro suivante dans le module ThisWorkbook :

Private Sub Workbook_Open()
If Weekday(Date) = 2 Then ' Test si le jour de la semaine est un lundi. Ici 2 représente le lundi.
Randomize
With Sheets("A L AFFICHE")
Lig = .Range("A32000").End(xlUp).Row
Do
T = Int((Lig * Rnd) + 1)
Loop Until .Range("A" & T) <> Sheets("CCT").Range("A1")
Sheets("CCT").Range("A1") = .Range("A" & T)
End With
End If
End Sub

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

Bonsoir,

=SI(JOURSEM(AUJOURDHUI();2)=1;INDEX('A L AFFICHE'!A1:A52;ALEA.ENTRE.BORNES(1;52));"")

A+

bonjour GerardCalc

la formule fonctionne nickel, mais restera t'elle jusqu'au lundi suivant ou le theme a l'affiche de la semaine sera vierge des le mardi ?

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

Bonjour jokerfidelio, GerardCalc,

Une version en VBA.

Mettre la macro suivante dans le module ThisWorkbook :

Private Sub Workbook_Open()
If Weekday(Date) = 2 Then ' Test si le jour de la semaine est un lundi. Ici 2 représente le lundi.
Randomize
With Sheets("A L AFFICHE")
Lig = .Range("A32000").End(xlUp).Row
Do
T = Int((Lig * Rnd) + 1)
Loop Until .Range("A" & T) <> Sheets("CCT").Range("A1")
Sheets("CCT").Range("A1") = .Range("A" & T)
End With
End If
End Sub

Bonjour CBernardT, merci pour le boulot...

je n'arrive pas a afficher ailleurs que dans la cellule A1 le resultat !!!

cdlt

 

[CBernardT]

Re : Texte aléatoire tous les lundi

Change la destination du texte aléatoire dans les deux lignes de code suivante :

Loop Until .Range("A" & T) <> Sheets("CCT").Range("A1")
Sheets("CCT").Range("A1") = .Range("A" & T) : ici c'est la cellule A1 de la feuille "CCT"

 

[STephane]

Re : Texte aléatoire tous les lundi

bonjour,

J'ai bien aimé la réponse de GerardCalc.
Toutefois, si tu aimerais que le message persiste comme tu l'as laissé entendre dans ta réponse à son message, alors je crois que tu le peux faire qu'avec VBA.

En optant pour un mixage des réponses de GerardCalc et Bernard, tu peux aussi écrire cela :

private sub workbook_open()
Dim dWeekday As Double
Dim dRandWeek As Double

' Obtenir le jour de la semaine / Get Week day
dWeekday = Application.WorksheetFunction.Weekday(today, 2)

' Obtenir un nombre au hasard entre 1 & 52 / Get random value from 1 to 52 (weeks)
dRandWeek = Application.WorksheetFunction.RandBetween(1, 52)

' 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 = Application.WorksheetFunction.Index(AFFICHE.Columns("A").Range("A1:A52"), dRandWeek)
    CCT.Range("A1").Value = dMessage

End If
End Sub

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

bonjour,

J'ai bien aimé la réponse de GerardCalc.
Toutefois, si tu aimerais que le message persiste comme tu l'as laissé entendre dans ta réponse à son message, alors je crois que tu le peux faire qu'avec VBA.

En optant pour un mixage des réponses de GerardCalc et Bernard, tu peux aussi écrire cela :

private sub workbook_open()
Dim dWeekday As Double
Dim dRandWeek As Double

' Obtenir le jour de la semaine / Get Week day
dWeekday = Application.WorksheetFunction.Weekday(today, 2)

' Obtenir un nombre au hasard entre 1 & 52 / Get random value from 1 to 52 (weeks)
dRandWeek = Application.WorksheetFunction.RandBetween(1, 52)

' 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 = Application.WorksheetFunction.Index(QUALITE.Columns("A").Range("A1:A52"), dRandWeek)
    CCT.Range("B16").Value = dMessage

End If
End Sub

STephane bonjour

je n'arrive pas a utiliser le code. le texte dans la feuille QUALITE ne s'affiche pas en B16 sur la feuille CCT
ci joint fichier définitif
cdlt

 

[JCGL]

Re : Texte aléatoire tous les lundi

Bonjour à tous,

Peux-tu essayer ceci :

Option Explicit
Private Sub WorkBook_Open()
Dim dWeekday As Double
Dim dRandWeek As Double
Dim dMessage As String
' Obtenir le jour de la semaine / Get Week day
dWeekday = WorksheetFunction.Weekday(Date, 2)
' Obtenir un nombre au hasard entre 1 & 52 / Get random value from 1 to 52 (weeks)
dRandWeek = Application.WorksheetFunction.RandBetween(1, 52)
' 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"), dRandWeek)
    Sheets("CCT").Range("B16").Value = dMessage
End If
End Sub

A+ à tous

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

Bonjour à tous,

Peux-tu essayer ceci :

Option Explicit
Private Sub WorkBook_Open()
Dim dWeekday As Double
Dim dRandWeek As Double
Dim dMessage As String
' Obtenir le jour de la semaine / Get Week day
dWeekday = WorksheetFunction.Weekday(Date, 2)
' Obtenir un nombre au hasard entre 1 & 52 / Get random value from 1 to 52 (weeks)
dRandWeek = Application.WorksheetFunction.RandBetween(1, 52)
' 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"), dRandWeek)
    Sheets("CCT").Range("B16").Value = dMessage
End If
End Sub

A+ à tous

bonjour JCGL
Aucun résultat, est ce dus au faite que nous sommes pas lundi ? question bête surement !

cdlt

 

[JCGL]

Re : Texte aléatoire tous les lundi

Bonjour à tous,

Très certainement...
Remplace If dWeekday = 2 Then par If dWeekday = 7 Then

A+ à tous

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

Merci a tous cela fonctionne impeccablement

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

y a t'il la possibilité de, non pas de faire un aléatoire, mais de forcer une distribution toujours de 1 a 52 mais cette fois ci dans l'ordre
et toujours les lundi :

Option Explicit
Private Sub WorkBook_Open()
Dim dWeekday As Double
Dim dRandWeek As Double
Dim dMessage As String
' Obtenir le jour de la semaine / Get Week day
dWeekday = WorksheetFunction.Weekday(Date, 2)
' Obtenir un nombre au hasard entre 1 & 52 / Get random value from 1 to 52 (weeks)
dRandWeek = Application.WorksheetFunction.RandBetween(1, 52)
' 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"), dRandWeek)
    Sheets("CCT").Range("B16").Value = dMessage
End If
End Sub

Cdlt

 

[STephane]

Re : Texte aléatoire tous les lundi

Bonsoir,

Avec la variation demandée.

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

 

[jokerfidelio]

Re : Texte aléatoire tous les lundi

STephane

il y a un message d'erreur de syntaxe


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