Toutes mes réponses sur les forums
-
AuteurMessages
-
Lionel
ParticipantVoilà, c’est via WeTransfer.
Lionel
ParticipantPimpin, tu aurais une adresse mail pour que je te transfères le fichier ?
Lionel
ParticipantPimpin,
Je pense que je ne peux pas transférer ce genre de fichiers via cette plateforme.
Suis ce lien : HôtelsLionel
ParticipantUne nouvelle épreuve :
Private Sub CommandButton1_Click() DateDebut = TextBox1.Value DateFin = Now() Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut)) NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin) NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin)) NbJours = Day(DateFin) - Day(DateDebut) If NbJours < 0 Then NbMois = NbMois - 1 NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours End If If NbAns = 0 Then sA = "" Else _ If NbAns = 1 Then sA = NbAns & " an " Else sA = NbAns & " ans " If NbMois = 0 Then sM = "" Else sM = NbMois & " mois " If NbJours = 0 Then sJ = "" Else If NbJours = 1 Then sJ = NbJours & " jour" Else sJ = NbJours & " jours" If NbMois = 0 And NbJours = 0 Then DiffDateAMJ = "Vous avez : " & Trim$(sA) & " aujourd'hui, JOYEUX ANNIVERSAIRE" Else DiffDateAMJ = "Vous avez : " & Trim$(sA & sM & sJ) End If MsgBox DiffDateAMJ Unload UserForm1 End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 8 Then If Right(TextBox1, 1) = "/" Then TextBox1 = Mid(TextBox1, 1, Len(TextBox1) - 1) ElseIf KeyCode = 46 Then TextBox1 = "" End If End Sub Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode < 96 Or KeyCode > 105 Then If TextBox1 <> "" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1) End If Select Case Len(TextBox1.Text) Case 2: If Val(TextBox1.Value) > 31 Then TextBox1.Value = "": MsgBox "Jour trop grand" Else TextBox1 = TextBox1 & "/" Case 5: If Mid(TextBox1, 4, 2) > 12 Then TextBox1.Value = Mid(TextBox1, 1, 3): MsgBox "Mois trop grand" Else TextBox1 = TextBox1 & "/" Case 10: If Not IsDate(TextBox1) Or Val(Mid(TextBox1, 7, 4)) < Val(Mid(Now(), 7, 4)) - 120 Or CDate(TextBox1) > Now() - 1 _ Then MsgBox "N'importe quoi !" & vbCrLf & "Allez recommence!!!": TextBox1 = "" Case Is > 10: TextBox1 = Mid(TextBox1, 1, 10) End Select End Sub
Lionel
ParticipantSi tu veux forcer voici un autre code. J’ai créé vite fait un UserForm1 avec un TextBox1.
Private Sub CommandButton1_Click() DateDebut = TextBox1.Value DateFin = Now() Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut)) NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin) NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin)) NbJours = Day(DateFin) - Day(DateDebut) If NbJours < 0 Then NbMois = NbMois - 1 NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours End If If NbAns = 0 Then sA = "" Else _ If NbAns = 1 Then sA = NbAns & " an " Else sA = NbAns & " ans " If NbMois = 0 Then sM = "" Else sM = NbMois & " mois " If NbJours = 0 Then sJ = "" Else If NbJours = 1 Then sJ = NbJours & " jour" Else sJ = NbJours & " jours" If NbMois = 0 And NbJours = 0 Then DiffDateAMJ = "Vous avez : " & Trim$(sA) & " aujourd'hui, JOYEUX ANNIVERSAIRE" Else DiffDateAMJ = "Vous avez : " & Trim$(sA & sM & sJ) End If MsgBox DiffDateAMJ Unload UserForm1 End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 8 Then If Right(TextBox1, 1) = "/" Then TextBox1 = Mid(TextBox1, 1, Len(TextBox1) - 1) ElseIf KeyCode = 46 Then TextBox1 = "" End If End Sub Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode < 96 Or KeyCode > 105 Then If TextBox1 <> "" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1) End If Select Case Len(TextBox1.Text) Case 2: If Val(TextBox1.Value) > 31 Then TextBox1.Value = "": MsgBox "jour trop grand" Else TextBox1 = TextBox1 & "/" Case 5: If Mid(TextBox1, 4, 2) > 12 Then TextBox1.Value = Mid(TextBox1, 1, 3): MsgBox "mois trop grand" Else TextBox1 = TextBox1 & "/" Case 10: If Not IsDate(TextBox1) Then MsgBox "tu veux une claque ou quoi?" & vbCrLf & " Ou ta vu que ce jour existe dans le calendrier" & vbCrLf & " allez recommence!!!": TextBox1 = "" Case 11: TextBox1 = Mid(TextBox1, 1, 10) End Select End Sub
Lionel
ParticipantTu ajoutes ceci
... While Not IsDate(DateDebut) DateDebut = InputBox("Entrez une date", "Date", DateDebut) <strong>If DateDebut = "" Then Exit Sub</strong> Wend ...
Lionel
ParticipantSalut Pimpin,
Voici un petit fichier avec quelques trucs (beaucoup en formule et sans VBA). Tu as plusieurs onglets :
. BD : c’est la base de données permettant le lien entre immeuble, étage et chambre. J’y ai inclus le prix.
. Visualisation : permet de voir – mois par mois – les chambres réservées
. Réservation : c’est la feuille où tout va s’enregistrer. On y touche pas.
. Encodage : c’est là que tu encodes tes données (tu peux y donner plus de relief pour en faire un vrai formulaire). En fonction des données, il t’indiques si c’est valide ou non comme réservation : réagit sur la période et la chambre.Ensuite, tu valides la réservation en appuyant sur le bouton Go! qui a ce petit code vba :
Sub GoReservation() Dim Table(16) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual DerniereLigne = Sheets("Réservation").Range("A1").End(xlDown).Row + 1 Sheets("Réservation").Unprotect "" With Sheets("Encodage") .Activate If .Range("A2").Value = "NOK" Or IsNumeric(.Range("G5").Value) = False _ Then MsgBox "Réservation non valide": _ Application.ScreenUpdating = True: _ Application.Calculate: _ Application.Calculation = xlCalculationAutomatic: _ Exit Sub Table(1) = .Range("A5").Value Table(2) = .Range("C5").Value Table(3) = .Range("E5").Value Table(4) = .Range("A8").Value Table(5) = .Range("C8").Value Table(6) = .Range("E8").Value Table(7) = .Range("G8").Value Table(8) = .Range("A12").Value Table(9) = .Range("C12").Value Table(10) = .Range("E12").Value Table(11) = .Range("A15").Value Table(12) = .Range("C15").Value Table(13) = .Range("E15").Value Table(14) = .Range("A18").Value Table(15) = .Range("C18").Value Table(16) = .Range("E18").Value End With With Sheets("Réservation") .Activate .Range("A" & DerniereLigne).Value = Table(1) .Range("B" & DerniereLigne).Value = Table(2) .Range("C" & DerniereLigne).Value = Table(3) .Range("E" & DerniereLigne).Value = Table(4) .Range("F" & DerniereLigne).Value = Table(5) .Range("G" & DerniereLigne).Value = Table(6) .Range("D" & DerniereLigne).Value = Table(7) .Range("H" & DerniereLigne).Value = Table(8) .Range("I" & DerniereLigne).Value = Table(9) .Range("J" & DerniereLigne).Value = Table(10) .Range("K" & DerniereLigne).Value = Table(11) .Range("L" & DerniereLigne).Value = Table(12) .Range("M" & DerniereLigne).Value = Table(13) .Range("N" & DerniereLigne).Value = Table(14) .Range("O" & DerniereLigne).Value = Table(15) .Range("P" & DerniereLigne).Value = Table(16) End With Sheets("Réservation").Protect "" Application.ScreenUpdating = True Application.Calculate Application.Calculation = xlCalculationAutomatic Sheets("Encodage").Activate MsgBox "Réservation encodée." End Sub
Attachments:
You must be logged in to view attached files.Lionel
ParticipantSalut Pimpin,
Voici ce que je te propose :Sub DateNaiss() Dim NbAns As Long, NbMois As Long, NbJours As Long Dim Tmp As Date, sA As String, sM As String, sJ As String DateDebut = "Ce n'est pas une date !" While Not IsDate(DateDebut) DateDebut = InputBox("Entrez une date", "Date", DateDebut) Wend DateFin = Now() Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut)) NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin) NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin)) NbJours = Day(DateFin) - Day(DateDebut) If NbJours < 0 Then NbMois = NbMois - 1 NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours End If If NbAns = 0 Then sA = "" Else _ If NbAns = 1 Then sA = NbAns & " an " Else sA = NbAns & " ans " If NbMois = 0 Then sM = "" Else sM = NbMois & " mois " If NbJours = 0 Then sJ = "" Else If NbJours = 1 Then sJ = NbJours & " jour" Else sJ = NbJours & " jours" If NbMois = 0 And NbJours = 0 Then DiffDateAMJ = "Vous avez : " & Trim$(sA) & " aujourd'hui, JOYEUX ANNIVERSAIRE" Else: DiffDateAMJ = "Vous avez : " & Trim$(sA & sM & sJ) End If MsgBox DiffDateAMJ End Sub
NB : je reviens vers toi dans quelques jours pour l’hôtel. 😉
Lionel
ParticipantBonjour Pimpin,
Il est difficile de se rendre compte où tu es arrivé. Surtout avec la Textbox10. Un petit printscreen rendrait la chose plus claire.
Pour tes listes en cascade, je te propose ceci (voir l’onglet LISTE).
Pour le code ceci en ayant créé un UserForm1 :Dim f Private Sub UserForm_Initialize() Set f = Sheets("LISTE") Set d = CreateObject("Scripting.Dictionary") For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row) d(c.Value) = "" Next c Me.ComboBox1.List = d.keys End Sub Private Sub ComboBox1_Change() Set d = CreateObject("Scripting.Dictionary") For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row) If c.Value = Me.ComboBox1 Then d(c.Offset(, 1).Value) = "" Next c Me.ComboBox2.List = d.keys Me.ComboBox2.ListIndex = -1 Me.ComboBox3.ListIndex = -1 End Sub Private Sub ComboBox2_Change() Set d = CreateObject("Scripting.Dictionary") For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row) If c.Value = Me.ComboBox1 And c.Offset(, 1).Value = Me.ComboBox2 Then d(c.Offset(, 2).Value) = "" Next c Me.ComboBox3.List = d.keys Me.ComboBox3.ListIndex = -1 End Sub
Attachments:
You must be logged in to view attached files.Lionel
ParticipantSalut Pinmpin,
Il te faut remplacer tous les « et les » par des"
.Private Sub Userform_Initialize() Dim colonne As Integer colonne = 2 Sheets("Liste").Range("B2:F2").Interior.ColorIndex = Clear Do While Cells(2, colonne).Value <> "" Userform1.Cbo_sport.AddItem Cells(2, colonne).Value colonne = colonne + 1 Loop End Sub
Attention, je ne connais pas ce code et je ne sais pas ce que tu comptes faire. Je me suis juste arrêter à cette erreur de compilation.
NB : n’hésite pas à créer un nouveau post car ce sont des sujets différents même s’ils sont dans un même projet.
Lionel
ParticipantTout dépend du type de bouton. Tu peux voir avec ceci
Private Sub Workbook_Open() Worksheets("Onglet").Shapes("Bouton 1").Visible = False End Sub
Pour l’exe, c’est un peu foutu.
Lionel
ParticipantSi tu veux éviter qu’il accède à ton code, tu peux y placer un mot de passe.
Avec ALT F11, tu arrives sur la fenêtre VBA.
Onglet ‘Outils’ → ‘Propriétés de VBAProject…’ → Onglet ‘Protection’, Cocher ‘Verrouiller le projet pour affichage’ → encoder ton MDP et le confirmer → OK → Quitter → Enregistrer → Fermer le fichier.
À la prochaine ouverture, il faudra mettre ce MDP pour aller modifier le code des macros.Lionel
ParticipantQue veux-tu dire par ‘un utilisateur ne puisse pas atteindre le menu développeur et modifier ma source‘.
Que ne doit-il pas faire ? Qu’entends-tu par modifier ta source ?
Lionel
ParticipantSalut Pimpin,
Voici une méthode. Elle fait ce que tu demandes : masquer le ruban à l’ouverture et faire apparaître le ruban à la fermeture.
Les deux PRIVATE SUB suivantes doivent être placées dans ThisWorkbook.Private Sub Workbook_BeforeClose(Cancel As Boolean) Rib_Vis = Application.CommandBars("Ribbon").Height > 100 If Rib_Vis = False Then Test_Ribbon End If End Sub
Private Sub Workbook_Open() Rib_Vis = Application.CommandBars("Ribbon").Height > 100 If Rib_Vis = True Then Test_Ribbon End If End Sub
Ensuite, tu crées un module où tu places les deux SUB suivantes :
Sub Test_Ribbon() 'Hide Ribbon if it is on the screen in 2010-2013 If RibbonState = 0 Then CommandBars.ExecuteMso "MinimizeRibbon" Else CommandBars.ExecuteMso "MinimizeRibbon" End If End Sub
Function RibbonState() As Long 'Result: 0=normal, -1=autohide RibbonState = (CommandBars("Ribbon").Controls(1).Height < 100) End Function
-
AuteurMessages