Bonjour,
Deux choses aujourd’hui :
1. Je planche sur une macro qui numérote les cellules lorsqu’on sélectionne une plage de cellule sous forme de colonne (c’est pour faire des devis).
L’idée c’est qu’on rentre nos désignations en laissant une ligne de libre entre chacune, de sélectionner la colonne à gauche et que la macro mette les numérotations, ex :
1. Démolition de mur
2. Construction de mur
Il faut être vigilant car une désignation peut se trouver sur deux lignes.
J’ai commencé à taper le code, le voici :
Option Explicit
Public k As Integer
Sub Numérotation()
Dim plage As Range, cel As Range
Set plage = Intersect(selection, Columns(selection.Column), ActiveSheet.UsedRange)
If plage Is Nothing Then Exit Sub
Application.ScreenUpdating = False
k = 0
For Each cel In plage
"Si la case à droite est non vide et que la case en dessus à droite est vide alors"
cel.Value = "k."
k = k + 1
Next
"Sinon, on passe à la suivante"
End Sub
2. J’ai une macro qui, lorsqu’on va taper un code dans une cellule va chercher la désignation y correspondant dans des onglets (tjrs pour la rédaction de devis).
Pour l’instant j’ai réussi à l’appliquer sur une sélection de cellule. Mais maintenant mon chef souhaiterai que la macro s’applique dès qu’on tape le code (il ne veut plus qu’on fasse control+A sur une sélection de cellule).
Les codes vont de 1 000 à 11 000. Pour info, voici le code :
Option Explicit
Public PetitVRD As Worksheet, installchant As Worksheet, travauxprepa As Worksheet,
Public I As Integer, J As Integer, k As Integer
Dim Licop As Integer, Licol As Integer, LiAnc As Integer, LiFin As Integer, LiOrg As Integer
Public Code As String, Un As String
Public Champ As Range, Calle As Range
Public Ach As String
Public Sub CopieLigne()
Dim plage As Range, cel As Range
Set plage = Intersect(selection, Columns(selection.Column), ActiveSheet.UsedRange)
If plage Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each cel In plage
If cel <> "" Then
cel.Activate
Set PetitVRD = ThisWorkbook.Worksheets("Petit VRD")
Set installchant = ThisWorkbook.Worksheets("Installation de chantier")
Set travauxprepa = ThisWorkbook.Worksheets("travaux préparatoires")
If ActiveSheet.Name = installchant.Name Then
I = MsgBox("Cette fonction ne s'applique pas dans la feuille Installation de chantier", vbOKOnly, "PetitVRD")
Exit Sub
End If
If ActiveSheet.Name = travauxprepa.Name Then
I = MsgBox("Cette fonction ne s'applique pas dans la feuille Travaux préparatoires", vbOKOnly, "PetitVRD")
Exit Sub
End If
LiAnc = 4: LiFin = 500
Set Calle = ActiveCell
Code = Calle.Value
Un = Calle.Offset(0, 1).Value
Licol = Calle.Row
With installchant
Set Champ = .Range(.Cells(LiAnc, 1), .Cells(LiFin, 1)).Find(what:=Code, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByColumns)
If Champ Is Nothing Then
With travauxprepa
Set Champ = .Range(.Cells(LiAnc, 1), .Cells(LiFin, 1)).Find(what:=Code, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByColumns)
If Champ Is Nothing Then
Else
Licop = Champ.Row
.Range(.Cells(Licop, 3), .Cells(Licop, 7)).Copy Destination:=PetitVRD.Cells(Licol, 2)
End If
End With
Else
Licop = Champ.Row
.Range(.Cells(Licop, 3), .Cells(Licop, 7)).Copy Destination:=PetitVRD.Cells(Licol, 2)
End If
End With
PetitVRD.Activate
Set Calle = Nothing
Set Champ = Nothing
Set PetitVRD = Nothing
Set installchant = Nothing
Set travauxterr = Nothing
End If
Next
End Sub
Deux choses aujourd’hui :
1. Je planche sur une macro qui numérote les cellules lorsqu’on sélectionne une plage de cellule sous forme de colonne (c’est pour faire des devis).
L’idée c’est qu’on rentre nos désignations en laissant une ligne de libre entre chacune, de sélectionner la colonne à gauche et que la macro mette les numérotations, ex :
1. Démolition de mur
2. Construction de mur
Il faut être vigilant car une désignation peut se trouver sur deux lignes.
J’ai commencé à taper le code, le voici :
Option Explicit
Public k As Integer
Sub Numérotation()
Dim plage As Range, cel As Range
Set plage = Intersect(selection, Columns(selection.Column), ActiveSheet.UsedRange)
If plage Is Nothing Then Exit Sub
Application.ScreenUpdating = False
k = 0
For Each cel In plage
"Si la case à droite est non vide et que la case en dessus à droite est vide alors"
cel.Value = "k."
k = k + 1
Next
"Sinon, on passe à la suivante"
End Sub
2. J’ai une macro qui, lorsqu’on va taper un code dans une cellule va chercher la désignation y correspondant dans des onglets (tjrs pour la rédaction de devis).
Pour l’instant j’ai réussi à l’appliquer sur une sélection de cellule. Mais maintenant mon chef souhaiterai que la macro s’applique dès qu’on tape le code (il ne veut plus qu’on fasse control+A sur une sélection de cellule).
Les codes vont de 1 000 à 11 000. Pour info, voici le code :
Option Explicit
Public PetitVRD As Worksheet, installchant As Worksheet, travauxprepa As Worksheet,
Public I As Integer, J As Integer, k As Integer
Dim Licop As Integer, Licol As Integer, LiAnc As Integer, LiFin As Integer, LiOrg As Integer
Public Code As String, Un As String
Public Champ As Range, Calle As Range
Public Ach As String
Public Sub CopieLigne()
Dim plage As Range, cel As Range
Set plage = Intersect(selection, Columns(selection.Column), ActiveSheet.UsedRange)
If plage Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each cel In plage
If cel <> "" Then
cel.Activate
Set PetitVRD = ThisWorkbook.Worksheets("Petit VRD")
Set installchant = ThisWorkbook.Worksheets("Installation de chantier")
Set travauxprepa = ThisWorkbook.Worksheets("travaux préparatoires")
If ActiveSheet.Name = installchant.Name Then
I = MsgBox("Cette fonction ne s'applique pas dans la feuille Installation de chantier", vbOKOnly, "PetitVRD")
Exit Sub
End If
If ActiveSheet.Name = travauxprepa.Name Then
I = MsgBox("Cette fonction ne s'applique pas dans la feuille Travaux préparatoires", vbOKOnly, "PetitVRD")
Exit Sub
End If
LiAnc = 4: LiFin = 500
Set Calle = ActiveCell
Code = Calle.Value
Un = Calle.Offset(0, 1).Value
Licol = Calle.Row
With installchant
Set Champ = .Range(.Cells(LiAnc, 1), .Cells(LiFin, 1)).Find(what:=Code, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByColumns)
If Champ Is Nothing Then
With travauxprepa
Set Champ = .Range(.Cells(LiAnc, 1), .Cells(LiFin, 1)).Find(what:=Code, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByColumns)
If Champ Is Nothing Then
Else
Licop = Champ.Row
.Range(.Cells(Licop, 3), .Cells(Licop, 7)).Copy Destination:=PetitVRD.Cells(Licol, 2)
End If
End With
Else
Licop = Champ.Row
.Range(.Cells(Licop, 3), .Cells(Licop, 7)).Copy Destination:=PetitVRD.Cells(Licol, 2)
End If
End With
PetitVRD.Activate
Set Calle = Nothing
Set Champ = Nothing
Set PetitVRD = Nothing
Set installchant = Nothing
Set travauxterr = Nothing
End If
Next
End Sub