Les code VBA
Ardwer.fr
Nextinpact
1) Ouverture
Sub badges()
If Cells(5, 2).Value = "Hall" Then
ActiveCell.Value = _
"=IF(OR(R25C[-1]=R37C[-1],R25C[-1]=R38C[-1],R25C[-1]=R39C[-1],R25C[-1]=R40C[-1],R25C[-
1]=R41C[-1]),R38C[-2],"""")"
Range("C24").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R25C[-1]=R37C[-1],R25C[-1]=R38C[-1],R25C[-1]=R39C[-1],R25C[-1]=R40C[-1],R25C[-
1]=R41C[-1]),R37C[-2],R37C)"
Range("C25").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R25C[-1]=R38C[-1],R25C[-1]=R39C[-1],R25C[-1]=R40C[-1],R25C[-1]=R41C[-1]),R38C[-
2],"""")"
Range("C26").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R25C[-1]=R39C[-1],R25C[-1]=R40C[-1],R25C[-1]=R41C[-1]),R39C[-2],"""")"
Range("C27").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R25C[-1]=R40C[-1],R25C[-1]=R41C[-1]),R40C[-2],"""")"
Range("C28").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R25C[-1]=R41C[-1]),R41C[-2],"""")"
Range("C22").Select
Else
Cells(5, 2).Value = "Parking"
Range("C24:D28").Select
Selection.Clear
End If
End Sub
2) Suppression si X=0
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B8")) Is Nothing Then
Range("B17").Value = ""
Range("B18").Value = ""
Range("B24").Value = ""
End If
If Not Intersect(Target, Range("B17")) Is Nothing Then
Range("B18").Value = ""
Range("B24").Value = ""
End If
If Not Intersect(Target, Range("B18")) Is Nothing Then
Range("B24").Value = ""
End If
End Sub
3) Adresse de parking et suppression de badges couleur
Sub Adresseparking()
'
' Adresseparking Macro
'
'
Range("A19").Select
ActiveCell.FormulaR1C1 = "Adresse Place Parking"
Range("A19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("A19:B19").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("C24:D28").Select
Selection.Clear
End Sub
4) Si hall si non parking
Sub hall()
If Cells(5, 2).Value = "Hall" Then
Range("C24").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R25C[-1]=R37C[-1],R25C[-1]=R38C[-1],R25C[-1]=R39C[-1],R25C[-1]=R40C[-
1],R25C[-1]=R41C[-1]),R37C[-2],R37C)"
Range("C25").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R25C[-1]=R38C[-1],R25C[-1]=R39C[-1],R25C[-1]=R40C[-1],R25C[-1]=R41C[-
1]),R38C[-2],"""")"
Range("C26").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R25C[-1]=R39C[-1],R25C[-1]=R40C[-1],R25C[-1]=R41C[-1]),R39C[-2],"""")"
Range("C27").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R25C[-1]=R40C[-1],R25C[-1]=R41C[-1]),R40C[-2],"""")"
Range("C28").Select
ActiveCell.FormulaR1C1 = "=IF(OR(R25C[-1]=R41C[-1]),R41C[-2],"""")"
Range("D31").Select
Selection.Copy
Range("D24").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("D24:D28"), Type:=xlFillDefault
Range("D24:D28").Select
Range("C24:D28").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("C24:C28").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("D24:D28").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A19:B19").Select
Selection.Clear
Else
Cells(5, 2).Value = "Parking"
Range("C24:D28").Select
Selection.Clear
ActiveWindow.DisplayWhitespace = False
Range("A19").Select
ActiveCell.FormulaR1C1 = "Adresse Place Parking"
Range("A19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("A19:B19").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If
End Sub
