suppréssion de ligne

F

faguer

XLDnaute Nouveau
Bonjour a tous
étant novice et n'ayant jamais eu de formation excel je faisait mai macro avec le formulaire et après avoir un petit peut compris je modifiait cela fonctionnais bien.
j'ai décider de transformer mes macro en utilisant activeX
et je bloque sur une action qui est celle de supprimer des lignes quand j'utilise le code tout seul il fonctionne trés bien


Private Sub CommandButton1_Click()
Sheets("commande").Select


'supprimer la protection a faire

'Suppréssion des lignes pour suprimer les page commandes si pas de ligne de commande
Dim Ligne As Long
For Ligne = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(Ligne, "A") = "" Then Rows(Ligne).Delete
Next Ligne


ActiveSheet.Range("W8:AA39").Select
Selection.Cut
ActiveSheet.Range("R40").Select
ActiveSheet.Paste
ActiveSheet.Range("T8:V71").Select
Selection.Cut
ActiveSheet.Range("R72").Select
ActiveSheet.Paste
ActiveSheet.Range("S8:U135").Select
Selection.Cut
ActiveSheet.Range("R136").Select
ActiveSheet.Paste
ActiveSheet.Range("S200:S263").Select
Selection.Cut
ActiveSheet.Range("R264").Select
ActiveSheet.Paste
ActiveSheet.Range("R8:R349").Select
ActiveSheet.Range("R349").Activate
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Add Key:=ActiveSheet.Range( _
"R8:R327"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("commande").Sort
.SetRange Range("R8:R327")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("S8").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],"""",RC[-1])"
ActiveSheet.Range("S8").Select
Selection.AutoFill Destination:=ActiveSheet.Range("S8:S245"), Type:=xlFillDefault
ActiveSheet.Range("S8:S245").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Add Key:=ActiveSheet.Range( _
"S8:S245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("commande").Sort
.SetRange Range("S8:S245")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Add Key:=ActiveSheet.Range("S8"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("commande").Sort
.SetRange Range("S8:S245")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("S8:S17").Select
Selection.Copy
ActiveSheet.Range("AZ1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("O1").Select
End Sub






Quand je le glisse dans la macro final il ne fonctionne pas

Private Sub CommandButton1_Click()
ActiveSheet.Unprotect ' suppréssion de la protection
Sheets("listing 2").Select
ActiveSheet.Range("i2:i5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'suppression des produit sans quantiter
' création des page de commande
Sheets("commande").Select
ActiveSheet.Unprotect ' suppréssion de la protection
ActiveSheet.Rows("8:16").Select
Selection.Copy
ActiveSheet.Range("A17").Select
ActiveSheet.Paste
ActiveSheet.Range("A26").Select
ActiveSheet.Paste
ActiveSheet.Range("A35").Select
ActiveSheet.Paste
' selection de la zone d'impréssion
Application.CutCopyMode = False
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$6"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$a$1:$n$42"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 94
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
'reglage saut de page
Set ActiveSheet.HPageBreaks(2).Location = ActiveSheet.Range("A25")
Set ActiveSheet.HPageBreaks(1).Location = ActiveSheet.Range("A16")
Set ActiveSheet.HPageBreaks(3).Location = ActiveSheet.Range("A34")
'transfere des lignes de commandes
Sheets("listing 2").Select
ActiveSheet.Rows("2:6").Select
Selection.Copy
Sheets("commande").Select
ActiveSheet.Rows("8:8").Select
ActiveSheet.Range("E8").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("listing 2").Select
ActiveSheet.Rows("7:11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("commande").Select
ActiveSheet.Rows("17:17").Select
ActiveSheet.Range("E17").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("listing 2").Select
ActiveSheet.Rows("12:16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("commande").Select
ActiveSheet.Rows("26:26").Select
ActiveSheet.Range("E26").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("listing 2").Select
ActiveSheet.Rows("17:21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("commande").Select
ActiveSheet.Rows("35:35").Select
ActiveSheet.Range("E35").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'format colonne l
ActiveSheet.Range("m8:m12").Select
ActiveSheet.Range("m8:m12,m17:m21").Select
ActiveSheet.Range("m17").Activate
ActiveSheet.Range("m8:m12,m17:m21,m26:m30").Select
ActiveSheet.Range("m26").Activate
ActiveSheet.Range("m8:m12,m17:m21,m26:m30,m35:m39").Select
ActiveSheet.Range("m35").Activate
With Selection
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveSheet.Range("L6").Select
'format colonne E
ActiveSheet.Range("f8:f12,f17:f21").Select
ActiveSheet.Range("f17").Activate
ActiveSheet.Range("f8:E12,f17:f21,f26:f30").Select
ActiveSheet.Range("f26").Activate
ActiveSheet.Range("f8:E12,f17:f21,f26:f30,f35:f39").Select
ActiveSheet.Range("f35").Activate
With Selection
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' remplissage de la colonne a afin de ne pas supprimer la page
ActiveSheet.Range("A1").Select
ActiveCell.FormulaR1C1 = "*"
ActiveSheet.Range("A1").Select
Selection.AutoFill Destination:=ActiveSheet.Range("A1:A15"), Type:=xlFillDefault
ActiveSheet.Range("A1:A15").Select
ActiveCell.FormulaR1C1 = "*"
ActiveSheet.Range("A16").Select
ActiveCell.FormulaR1C1 = "=IF(R17C[8]="""","""",""*"")"
ActiveSheet.Range("A16").Select
Selection.AutoFill Destination:=ActiveSheet.Range("A16:A24"), Type:=xlFillDefault
ActiveSheet.Range("A16:A24").Select
ActiveSheet.Range("A25").Select
ActiveCell.FormulaR1C1 = "=IF(R26C[8]="""","""",""*"")"
ActiveSheet.Range("A26").Select
ActiveSheet.Range("A25").Select
Selection.AutoFill Destination:=ActiveSheet.Range("A25:A33"), Type:=xlFillDefault
ActiveSheet.Range("A25:A33").Select
ActiveSheet.Range("A34").Select
ActiveCell.FormulaR1C1 = "=IF(R35C[8]="""","""",""*"")"
ActiveSheet.Range("A34").Select
Selection.AutoFill Destination:=ActiveSheet.Range("A34:A42"), Type:=xlFillDefault
ActiveSheet.Range("A34:A42").Select

'suppréssion des ligne sans *
'Suppréssion des lignes pour suprimer les page commandes si pas de ligne de commande
ActiveWorkbook.Sheets("commande").Activate
Dim Ligne As Long
For Ligne = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(Ligne, "A") = "" Then Rows(Ligne).Delete
Next Ligne

' copier coller valeur
ActiveSheet.Columns("A:A").Select
ActiveSheet.Range("A22").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("B22").Select
Application.CutCopyMode = False
'somme ligne
ActiveSheet.Range("L8").Select
ActiveCell.FormulaR1C1 = "=RC[-3]*RC[-1]"
ActiveSheet.Range("L8").Select
Selection.AutoFill Destination:=ActiveSheet.Range("L8:L12"), Type:=xlFillDefault
ActiveSheet.Range("L8:L12").Select
Selection.Copy
ActiveSheet.Range("L17").Select
ActiveSheet.Paste
ActiveSheet.Range("L26").Select
ActiveSheet.Paste
ActiveSheet.Range("L35").Select
ActiveSheet.Paste
ActiveSheet.Range("M37").Select
Application.CutCopyMode = False
' somme depence
ActiveSheet.Range("L40").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[-11]=""*"",R[-5]C+R[-4]C+R[-3]C+R[-2]C+R[-1]C,"""")"
ActiveSheet.Range("L41").Select
ActiveSheet.Range("L31").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[-11]=""*"",R[-5]C+R[-4]C+R[-3]C+R[-2]C+R[-1]C,"""")"
ActiveSheet.Range("L32").Select
ActiveSheet.Range("L22").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[-11]=""*"",R[-5]C+R[-4]C+R[-3]C+R[-2]C+R[-1]C,"""")"
ActiveSheet.Range("L23").Select
ActiveSheet.Range("L13").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[-11]=""*"",R[-5]C+R[-4]C+R[-3]C+R[-2]C+R[-1]C,"""")"
ActiveSheet.Range("L14").Select

' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' remettre la protection de la page
End Sub


je cherche depuis plus de 10 jours et la je comprend pas

merci de m'indiquer mon erreurs d'encodage et surtout de m'expliquer pourquoi sa bug



merci d’avance Bruno
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir

Pour suggestion
Une macro simple (sans boucle) pour supprimer les lignes si cellule en colonne A vide.
Code: 
Sub SupprimerLigneVideColonneA()
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(4).EntireRow.Delete
End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir

Rien ne passe...
Hum pas si sur ;)
Copies ces macros dans un classeur vide
Puis lance la macro nommée Test
Quelque chose s'est bien passé, non ?
Et ce n'est pas rien ;)
Code: 
Sub Test()
RemplirDesCellules "A1:K1"
MsgBox "Supprimer les lignes si cellule vide en colonne A?", vbInformation + vbOKOnly, "Test"
SupprimerLigneVideColonneA
End Sub
Private Sub RemplirDesCellules(adr$)
Sheets.Add
With Range(adr)
.FormulaR1C1 = "=REPT(CHAR(64+COLUMN()),3)&ROW()"
.Resize(2).AutoFill Destination:=Range("A1:K38"), Type:=xlFillDefault
End With: [A1:K38].Value = [A1:K38].Value
End Sub
Private Sub SupprimerLigneVideColonneA()
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(4).EntireRow.Delete
End Sub
 
Vote positif 0 Vote négatif
F

faguer

XLDnaute Nouveau
Staple1600 à dit:
Bonsoir

Rien ne passe...
Hum pas si sur ;)
Copies ces macros dans un classeur vide
Puis lance la macro nommée Test
Quelque chose s'est bien passé, non ?
Et ce n'est pas rien ;)
Code: 
Sub Test()
RemplirDesCellules "A1:K1"
MsgBox "Supprimer les lignes si cellule vide en colonne A?", vbInformation + vbOKOnly, "Test"
SupprimerLigneVideColonneA
End Sub
Private Sub RemplirDesCellules(adr$)
Sheets.Add
With Range(adr)
.FormulaR1C1 = "=REPT(CHAR(64+COLUMN()),3)&ROW()"
.Resize(2).AutoFill Destination:=Range("A1:K38"), Type:=xlFillDefault
End With: [A1:K38].Value = [A1:K38].Value
End Sub
Private Sub SupprimerLigneVideColonneA()
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(4).EntireRow.Delete
End Sub
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
F

faguer

XLDnaute Nouveau
Bonjour

j'avais aussi ce résultat avant comme expliquer dans ma demande d'aide quand j utilise le code tout seule il fonctionne bien,
quand le l’inclus dans ma suite de code il ne fonctionne pas.

en sachant que ce code a été fait a la base Contrôles de formulaire (et il fonctionnait bien)et que maintenant je le transforme en Contrôles active X

merci pour ton aide
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour

faguer
Peut-être serait-il temps pour toi de joindre une copie anonymisée de ton classeur (ou un extrait) afin qu'on puisse y voir plus clair et faire des tests sur nos PC, non ? ;)
NB: Fichier qui contiendra le code VBA que tu utilises actuellement.
 
Vote positif 0 Vote négatif
F

faguer

XLDnaute Nouveau
Bonjour
voici le fichier
on clique sur création commande puis on mets un chiffre dans la colonne quantité.

la macro qui ne fonctionne pas est sur le boutons "création de vos bon de commande" dans la page listing 2

la page je ce protege a chaque action mais il n'y a pas de mots de passe

merci pour votre aide
n'hésitez pas a critiqué ma façons de faire cela ne pourra que me faire grandir dans excel

Cordialement

bruno
 

Pièces jointes

  • bruno guichet unique test.zip
    1.8 MB · Affichages: 4
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir

Relis mon précédent message:
Je parlais d'une copie ou d'un extrait
Pas d'un fichier de plus de 10Mo avec un bordel pas possible dans le projet VBA
(Plus de trente modules!!!)

Quand j'ai voulu ouvrir ton classeur, mon Excel (dans un éclair de lucidité ;)) s'est auto-terminé...

Bref joins plutôt un fichier "light" créé pour l'occasion avec le strict nécessaire pour illustrer ton problème.

PS : En plus, ton fichier contient encore quelques traces de données confidentielles...
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir,

Ton classeur contient toujours 30 modules vides...
(je les ai supprimé et enregistrer ton classeur en *.xlsb)
Résultat (voir ci-dessous ;))
01Reduit.jpg

Ensuite, j'ai commencé à alléger ton code* (sans plus)
*: pour le moment, cela ne fait que la copie.
Peux-tu me dire si déjà le résultat est similaire à ce que fait ta macro initiale ?
(PS: j'ai testé sur ton fichier et sans erreur, donc cela devrait être de même sur ton PC)
NB: Teste sur le dernier fichier exemple de ton fil en supprimant ta macro existante (juste le temps du test)
VB: 
Private Sub CommandButton1_Click()
Dim i&
ActiveSheet.Unprotect  ' suppréssion de la protection
Sheets("listing 2").Range("I2:I5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'suppression des produit sans quantité
' création des page de commande
With Sheets("commande")
  .Unprotect  ' suppression de la protection
    For i = 8 To 35 Step 9
    .Range("F8:M16").Copy .Cells(i, "F")
    Application.CutCopyMode = False
    Next
    For i = 8 To 35 Step 9
    .Cells(i, "F").Resize(5, 8).Value = Sheets("listing 2").Range("F2:M6").Value
    Next
End With
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
426
ph.vanne
ph.vanne
G
  • Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
173
sylvanu
sylvanu
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
323
Phil69970
Phil69970
M
  • Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
16
Affichages
700
Phil69970
Phil69970
M
  • Question
XL 2021 VBA Excel Erreur 2023
Réponses
2
Affichages
184
MICHIS
M
K
  • Question
Microsoft 365 vba :Vlookup + incrémentation d'une plage de donnée
Réponses
1
Affichages
136
vgendron
vgendron
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
304
micie1509
micie1509
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
528
robpellan52
R
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
job75
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne

Membres actuellement en ligne

8 membres et 95 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 095
Messages
2 116 166
Membres
112 675
dernier inscrit
Tazra_IMOU