1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Private Function DiffJour(Dte1 As Date, Dte2 As Date) As Integer
If Weekday(Dte1, vbSaturday) <= 2 Then Dte1 = DateAdd("d", 3 - Weekday(Dte1, vbSaturday), Dte1)
If Weekday(Dte2, vbSaturday) <= 2 Then Dte2 = DateAdd("d", -Weekday(Dte2, vbSaturday), Dte2)
DiffJour = DateDiff("d", Dte1, Dte2, vbMonday) - 2 * DateDiff("ww", Dte1, Dte2, vbMonday)
End Function
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Sh As Worksheet
Dim c As Range, Plage As Range
Dim LastLig As Long
Dim Comnt As String
Cancel = True
LastLig = Cells(Rows.Count, "D").End(xlUp).Row
Set Plage = Intersect(Target, Range("D27:D" & LastLig))
If Not Plage Is Nothing Then
Application.ScreenUpdating = False
For Each c In Plage
If Trim(c.Value) <> "" Then
If MsgBox("Do you want book Ticket for " & CStr(Format(c.Value, "00000")) & "?", vbOKCancel + vbQuestion, "Booking Program") = vbOK Then
'Call Crea_Page(c)
Set Sh = Sheets(CStr(Format(c.Value, "00000")))
With Sheets("BOOK")
Sh.Range("C4").Value = Format(c.Value, "00000")
Sh.Range("C5").Value = Date
Sh.Range("C8").Value = .Cells(c.Row, "F").Value
Select Case DiffJour(Sh.Range("C5").Value, Sh.Range("C8").Value)
Case 0: Comnt = "TODAY"
Case 1: Comnt = "TOM"
Case 2: Comnt = "SPOT"
Case Is >= 3: Comnt = "FORW"
End Select
Sh.Range("C7").Value = Comnt
Sh.Range("C6").Value = .Cells(c.Row, "A").Value
Sh.Range("C9").Value = .Cells(c.Row, "K").Value & "/" & .Cells(c.Row, "L").Value
Comnt = ""
If .Cells(c.Row, "G").Value > 0 Then
Sh.Range("C11").Value = .Cells(c.Row, "K").Value
Sh.Range("C12").Value = .Cells(c.Row, "L").Value
Sh.Range("D11").Value = .Cells(c.Row, "G").Value
Sh.Range("D12").Value = .Cells(c.Row, "H").Value
Else
Sh.Range("C11").Value = .Cells(c.Row, "L").Value
Sh.Range("C12").Value = .Cells(c.Row, "K").Value
Sh.Range("D11").Value = .Cells(c.Row, "H").Value
Sh.Range("D12").Value = .Cells(c.Row, "G").Value
End If
Sh.Range("D11:D12").NumberFormat = "0.00"
Sh.Range("C13").Value = .Cells(c.Row, "M").Value
.Activate
End With
Set Sh = Nothing
End If
End If
Next c
End If
Set Plage = Nothing
End Sub |
Partager