Comment racourcir une macro

Le 09/01/2020 à 19:24

bonjour ,

j’essaie de raccourcir ma macro mais j'ai un peu de mal

de l'aide sera la bien venu

ma macro fonctionne bien mais elle est un peu longue

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("c6:ac34"), Target) Is Nothing Then
        Cancel = True
If ActiveCell = "" Then
If ActiveCell.Row < 15 And Cells(14, Target.Column) = "" Then
Cancel = True
 Nouveau.Show
End If
If ActiveCell.Row > 15 And ActiveCell.Row < 25 And Cells(24, Target.Column) = "" Then
Cancel = True
 Nouveau.Show
 End If
 If ActiveCell.Row > 25 And Cells(34, Target.Column) = "" Then
Cancel = True
 Nouveau.Show
End If
Else

    UserForm1.Lab1.Visible = False
    UserForm1.Lab2.Visible = False
    UserForm1.Lab3.Visible = False
    UserForm1.Lab4.Visible = False
    UserForm1.bat1.Visible = False
    UserForm1.bat2.Visible = False
    UserForm1.bat3.Visible = False
    UserForm1.bat4.Visible = False

UserForm1.Lab1 = CDate(Cells(4, Target.Column))
UserForm1.Lab2 = CDate(Cells(4, Target.Column + 1))
UserForm1.Lab3 = CDate(Cells(4, Target.Column + 2))
UserForm1.Lab4 = CDate(Cells(4, Target.Column + 3))
'UserForm1.bat1.Value = Format(UserForm1.bat1.Value, "general Number")
'UserForm1.bat2.Value = Format(UserForm1.bat2.Value, "general Number")
'UserForm1.bat3.Value = Format(UserForm1.bat3.Value, "general Number")
'UserForm1.bat4.Value = Format(UserForm1.bat4.Value, "general Number")

'1 cases ecrire dans label--------------------------------------
If ActiveCell.Row < 15 And Cells(14, Target.Column) = "1a" Then
  UserForm1.bat1 = Cells(15, Target.Column)
  UserForm1.Lab1.Visible = True
  UserForm1.bat1.Visible = True
UserForm1.bato = Cells(7, Target.Column)
UserForm1.bontop = Cells(9, Target.Column)

UserForm1.Show
   End If
 If ActiveCell.Row > 15 And ActiveCell.Row < 25 And Cells(24, Target.Column) = "1a" Then
  UserForm1.bat1 = Cells(25, Target.Column)
UserForm1.Lab1.Visible = True
UserForm1.bat1.Visible = True
UserForm1.bato = Cells(17, Target.Column)
UserForm1.bontop = Cells(19, Target.Column)
UserForm1.Show
End If
 If ActiveCell.Row > 25 And Cells(34, Target.Column) = "1a" Then
  UserForm1.bat1 = Cells(35, Target.Column)
UserForm1.Lab1.Visible = True
UserForm1.bat1.Visible = True
UserForm1.bato = Cells(27, Target.Column)
UserForm1.bontop = Cells(29, Target.Column)
UserForm1.Show
End If

'2 cases ecrire dans label--------------------------------------
If ActiveCell.Row < 15 And Cells(14, Target.Column) = "2a" Then
   UserForm1.bat1 = Cells(15, Target.Column)
   UserForm1.bat2 = Cells(15, Target.Column + 1)
   UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bato = Cells(7, Target.Column)
UserForm1.bontop = Cells(9, Target.Column)
 UserForm1.Show
   End If
If ActiveCell.Row > 15 And ActiveCell.Row < 25 And Cells(24, Target.Column) = "2a" Then
UserForm1.bat1 = Cells(25, Target.Column)
   UserForm1.bat2 = Cells(25, Target.Column + 1)
   UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
    UserForm1.bato = Cells(17, Target.Column)
UserForm1.bontop = Cells(19, Target.Column)
 UserForm1.Show
   End If
 If ActiveCell.Row > 25 And Cells(34, Target.Column) = "2a" Then
   UserForm1.bat1 = Cells(35, Target.Column)
   UserForm1.bat2 = Cells(35, Target.Column + 1)
   UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
    UserForm1.bato = Cells(27, Target.Column)
UserForm1.bontop = Cells(29, Target.Column)
 UserForm1.Show
   End If
 If ActiveCell.Row < 15 And Cells(14, Target.Column) = "2b" Then
  UserForm1.bat1 = Cells(15, Target.Column - 1)
  UserForm1.bat2 = Cells(15, Target.Column)
   UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bato = Cells(7, Target.Column)
  UserForm1.bontop = Cells(9, Target.Column)
  UserForm1.Show
  End If
If ActiveCell.Row > 15 And ActiveCell.Row < 25 And Cells(24, Target.Column) = "2b" Then
UserForm1.bat1 = Cells(25, Target.Column - 1)
  UserForm1.bat2 = Cells(25, Target.Column)
   UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
    UserForm1.bato = Cells(17, Target.Column)
UserForm1.bontop = Cells(19, Target.Column)
  UserForm1.Show
   End If
 If ActiveCell.Row > 25 And Cells(34, Target.Column) = "2b" Then
  UserForm1.bat1 = Cells(35, Target.Column - 1)
  UserForm1.bat2 = Cells(35, Target.Column)
   UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
    UserForm1.bato = Cells(27, Target.Column)
UserForm1.bontop = Cells(29, Target.Column)
  UserForm1.Show
   End If

  ' 3 cases ecrire dans label--------------------------------------
If ActiveCell.Row < 15 And Cells(14, Target.Column) = "3a" Then
   UserForm1.bat1 = Cells(15, Target.Column)
   UserForm1.bat2 = Cells(15, Target.Column + 1)
   UserForm1.bat3 = Cells(15, Target.Column + 2)
   UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.Lab3.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bat3.Visible = True
   UserForm1.bato = Cells(7, Target.Column)
   UserForm1.bontop = Cells(9, Target.Column)
   UserForm1.Show
   End If
If ActiveCell.Row > 15 And ActiveCell.Row < 25 And Cells(24, Target.Column) = "3a" Then
UserForm1.bat1 = Cells(25, Target.Column)
  UserForm1.bat2 = Cells(25, Target.Column + 1)
  UserForm1.bat3 = Cells(25, Target.Column + 2)
  UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.Lab3.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bat3.Visible = True
    UserForm1.bato = Cells(17, Target.Column)
UserForm1.bontop = Cells(19, Target.Column)
   UserForm1.Show
   End If
 If ActiveCell.Row > 25 And Cells(34, Target.Column) = "3a" Then
   UserForm1.bat1 = Cells(35, Target.Column)
  UserForm1.bat2 = Cells(35, Target.Column + 1)
  UserForm1.bat3 = Cells(35, Target.Column + 2)
  UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.Lab3.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bat3.Visible = True
    UserForm1.bato = Cells(27, Target.Column)
UserForm1.bontop = Cells(29, Target.Column)
   UserForm1.Show
   End If
 If ActiveCell.Row < 15 And Cells(14, Target.Column) = "3b" Then
  UserForm1.bat1 = Cells(15, Target.Column - 1)
  UserForm1.bat2 = Cells(15, Target.Column)
  UserForm1.bat3 = Cells(15, Target.Column + 1)
  UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.Lab3.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bat3.Visible = True
   UserForm1.bato = Cells(7, Target.Column)
UserForm1.bontop = Cells(9, Target.Column)
   UserForm1.Show
  End If
If ActiveCell.Row > 15 And ActiveCell.Row < 25 And Cells(24, Target.Column) = "3b" Then
UserForm1.bat1 = Cells(25, Target.Column - 1)
  UserForm1.bat2 = Cells(25, Target.Column)
  UserForm1.bat3 = Cells(25, Target.Column + 1)
  UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.Lab3.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bat3.Visible = True
   UserForm1.bato = Cells(17, Target.Column)
UserForm1.bontop = Cells(19, Target.Column)
   UserForm1.Show
  End If
 If ActiveCell.Row > 25 And Cells(34, Target.Column) = "3b" Then
 UserForm1.bat1 = Cells(35, Target.Column - 1)
  UserForm1.bat2 = Cells(35, Target.Column)
  UserForm1.bat3 = Cells(35, Target.Column + 1)
  UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.Lab3.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bat3.Visible = True
    UserForm1.bato = Cells(27, Target.Column)
UserForm1.bontop = Cells(29, Target.Column)
   UserForm1.Show
  End If
 If ActiveCell.Row < 15 And Cells(14, Target.Column) = "3c" Then
  UserForm1.bat1 = Cells(15, Target.Column - 2)
  UserForm1.bat2 = Cells(15, Target.Column - 1)
  UserForm1.bat3 = Cells(15, Target.Column)
  UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.Lab3.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bat3.Visible = True
   UserForm1.bato = Cells(7, Target.Column)
UserForm1.bontop = Cells(9, Target.Column)
   UserForm1.Show
  End If
If ActiveCell.Row > 15 And ActiveCell.Row < 25 And Cells(24, Target.Column) = "3c" Then
UserForm1.bat1 = Cells(25, Target.Column - 2)
  UserForm1.bat2 = Cells(25, Target.Column - 1)
  UserForm1.bat3 = Cells(25, Target.Column)
  UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.Lab3.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bat3.Visible = True
    UserForm1.bato = Cells(17, Target.Column)
UserForm1.bontop = Cells(19, Target.Column)
   UserForm1.Show
  End If
 If ActiveCell.Row > 25 And Cells(34, Target.Column) = "3c" Then
   UserForm1.bat1 = Cells(35, Target.Column - 2)
   UserForm1.bat2 = Cells(35, Target.Column - 1)
   UserForm1.bat3 = Cells(35, Target.Column)
   UserForm1.Lab1.Visible = True
   UserForm1.Lab2.Visible = True
   UserForm1.Lab3.Visible = True
   UserForm1.bat1.Visible = True
   UserForm1.bat2.Visible = True
   UserForm1.bat3.Visible = True
    UserForm1.bato = Cells(27, Target.Column)
UserForm1.bontop = Cells(29, Target.Column)
   UserForm1.Show
  End If

merci pour vos reponses

Cordialement

Le 09/01/2020 à 22:01

Salut caje17,

je vas pas faire tout le travail, mais voici le principe à suivre pour utiliser les boucles:

ce code par exemple:

    UserForm1.Lab1.Visible = False
    UserForm1.Lab2.Visible = False
    UserForm1.Lab3.Visible = False
    UserForm1.Lab4.Visible = False
    UserForm1.bat1.Visible = False
    UserForm1.bat2.Visible = False
    UserForm1.bat3.Visible = False
    UserForm1.bat4.Visible = False

UserForm1.Lab1 = CDate(Cells(4, Target.Column))
UserForm1.Lab2 = CDate(Cells(4, Target.Column + 1))
UserForm1.Lab3 = CDate(Cells(4, Target.Column + 2))
UserForm1.Lab4 = CDate(Cells(4, Target.Column + 3))

peut être remplacer par celui-là:

For i = 1 To 4
    UserForm1.Controls("Lab" & i).Visible = False
    UserForm1.Controls("bat" & i).Visible = False
    UserForm1.Controls("Lab" & i) = CDate(Cells(4, Target.Column + i - 1))
Next i

et ainsi de suite, bonne continuation

Rechercher des sujets similaires à "comment racourcir macro"