La méthode copy de la classe range a échoué

Le 11/08/2013 à 11:26

Bonjour,

J'aimerais éviter cette erreur (La méthode copy de la classe range a échoué) lorsque j'essaye d'insérer ou de supprimer une ligne à partir des cellules que je ne souhaite pas.

Je souhaite utiliser le bouton de commande "Ajouter ou supprimer lignes" seulement dans mon tableau ou il y a "Qté", "Uté", "Désignation", "P.U.", "Total HT", "%" et Avancement.

C'est pour cela que j'ai crée un nouveau nom dans "Gestionnaire des noms" (BlocageInsertionSuppressionLigne) avec "Fait référence à : ='Akisti Bat'!$A$1:$I$20;'Akisti Bat'!$A$41:$I$50)

Il me manque le code vba pour mettre un msgbox comme : "Veuillez sélectionner une cellule dans la plage adéquate" lorsque j'essaye d'insérer ou de supprimer de(s) ligne(s) depuis des cellules BlocageInsertionSuppressionLigne

Voici le code et le fichier :

Private Sub TAjouter_Click()
'Déclarations des variables
Dim ligne As Long, n As Long
ActiveSheet.Unprotect
ligne = Selection.Row
Application.ScreenUpdating = False
For n = 1 To CInt(NombreLigne.Value)
Selection.Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown
Range("A" & ligne & ":I" & ligne).Copy
Rows(ligne + 1).RowHeight = 15
Range("A" & ligne + 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("G" & ligne).Copy Destination:=Range("G" & ligne + 1)
Range("I" & ligne).Copy Destination:=Range("I" & ligne + 1)
ligne = ligne + 1
Next
Range("TotalH.T.").FormulaR1C1 = "=SUM(R21C:R[-1]C)"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingRows:=True
Unload Me
End Sub

Merci d'avance

A+

28facture-n-101-test.xlsm (197.46 Ko)
Le 11/08/2013 à 13:29

Bonjour

Je pense que pour la suppression de ligne tu veux avoir aussi le message

Tu peux supprimer la zone nommée "BlocageInsertionSuppressionLigne"

Remplaces la macro existante par celle-ci

Private Sub BoutonAjouterSupprimerLigne_Click()
Dim Plage As Range

  Set Plage = Range(Range("A" & Range("Surligneur").Row), Range("I" & Range("Surligneur").Row + Range("Surligneur").Rows.Count - 2))
  If Not Intersect(Plage, ActiveCell) Is Nothing Then
    AjouterSpprimerLigne.Show vbModeless
  Else
    MsgBox "Veuillez choisir une ligne entre " & Plage.Row & " et " & Plage.Row + Plage.Rows.Count - 1
  End If
End Sub
Le 11/08/2013 à 13:37

Bonjour Banzai64

Oui tout à fait

C'est à peu près s'que je voulais

Par contre je n'arrive plus à supprimer à supprimer de ligne dans mon tableau principale (le grand)

Puis vu que mes titres de mes colonnes je préfère le masquer, on peu pas changer la phrase par une autre, sans les citations de cellules

Merci Banzai64, je sais pas s'que j'aurais fait sans toi

Le 11/08/2013 à 14:00

Bonjour

Ronibo a écrit :

Par contre je n'arrive plus à supprimer à supprimer de ligne dans mon tableau principale (le grand)

Le tableau principal c'est le même que celui ou tu insères des lignes ?

Si c'est le même la suppression fonctionne

Ronibo a écrit :

on peu pas changer la phrase par une autre, sans les citations de cellules

Modifies le message (partie surlignée) par celui que tu veux

MsgBox "Veuillez choisir une ligne entre " & Plage.Row & " et " & Plage.Row + Plage.Rows.Count - 1

exemple

MsgBox "Perdu : vous êtes au mauvais endroit"
Le 11/08/2013 à 14:02

Re

J'essaye ça de suite,

Tu as pas une solution pour les insertions de lignes ?

Le 11/08/2013 à 14:23

re,

Je viens d'essayer pour le msgbox c'est bon c'est réglé

Mais je n'arrive pas à supprimer les lignes, la ou on a la possibilité d'insérer des lignes.

Je t'ai mis un fichier pour que tu puisse voir

21test.xlsm (201.78 Ko)
Le 11/08/2013 à 14:57

Bonjour

Pourquoi as tu modifié cette macro, il faut laisser l'ancienne

Private Sub TSupprimer_Click()
ActiveSheet.Unprotect
Selection.EntireRow.Delete
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingRows:=True
Me.Hide
End Sub

Version corrigée (j'ai laissé en place les macros anciennes - il faudra les effacer)

36ronibo-inserion-suppression-lignes-v001.xlsm (200.26 Ko)
Le 11/08/2013 à 15:21

Re,

Ahh ! J'ai compris, j'ai cru qu'il fallait que remplace le code qui se trouve dans usf par celui que tu m'as proposé

Merci Banzai64

A+

Je peux te poser une autre question? Du même genre.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
SaveAsUI = False
Cancel = True
With Worksheets("Akisti Bat")
Select Case Left(.Range("H10"), 1)
Case "B": Chemin = "C:\Akisti Bat\Bon de Commande\"
Case "D": Chemin = "C:\Akisti Bat\Devis\"
Case "F": Chemin = "C:\Akisti Bat\Factures\"
End Select
MyFile = Chemin & .Range("H10") & .Range("I10") & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("G14") & ")" & ".xlsm"
End With
Application.EnableEvents = False
Me.SaveAs MyFile
Application.EnableEvents = True
MsgBox "La facture ou le devis a bien été enregistrée !"
End Sub

Ce code qui se trouve dans ThisWorkbook.

Me permet d'enregistrer le fichier en le nommant puis en le classant dans le bon dossier automatiquement.

Je pense que c'est un fichier qui comporte le même nom, et me demande si je veux l'écraser.

Si je sélectionne "Non" sur cette question j'ai une erreur.

J'aimerais éviter aussi cette erreur par un msgbox (Le fichier n'a pas été enregistré)

Cela me permettra de poursuivre la saisie de ma facture et enregistrer plus tard.

a+

Le 11/08/2013 à 16:43

Bonjour

Remplaces la macro équivalente dans le module ThisWorkbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, MyFile As String

  SaveAsUI = False
  Cancel = True
  With Worksheets("Akisti Bat")
    Select Case Left(.Range("H10"), 1)
      Case "B": Chemin = "C:\Akisti Bat\Bon de Commande\"
      Case "D": Chemin = "C:\Akisti Bat\Devis\"
      Case "F": Chemin = "C:\Akisti Bat\Factures\"
    End Select
    MyFile = Chemin & .Range("H10") & .Range("I10") & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("G14") & ")" & ".xlsm"
  End With
  If Dir(MyFile) <> "" Then
    If MsgBox("Un fichier nommé '" & MyFile & "' existe déjà à cet emplacement" & vbCr & _
              "Voulez-vous le remplacer ?", vbInformation + vbYesNo + vbDefaultButton2, Application.UserName) <> vbYes Then
      MsgBox "Fichier non enregistré"
      Exit Sub
    End If
  End If

  Application.EnableEvents = False
  Application.DisplayAlerts = False
  Me.SaveAs MyFile
  Application.DisplayAlerts = False
  Application.EnableEvents = True
  MsgBox "La facture ou le devis a bien été enregistrée !"
End Sub
Le 11/08/2013 à 16:48

MMMMMMMMMEEEEEEEERCCCCCCCCCCCIIIIIIIIIIIIIIIIIIIII BEEEEEEAAAAAAUUUUUUUUCCCCCCOOOOOUUUUUUUPPPPPP BANZAI64

Re,

Je sais j'abuse mais juste si on peut faire la même chose lorsqu'il trouve pas le répertoire

Mettre un message comme,

Msgbox "Le répertoire (chemin) existe pas"

a+

Re Banzai64

Lorsqu'un répertoire n'existe pas, les enregistrer automatiquement dans c:/

Et faire apparaître un message comme :

"Votre facture ou de devis à été enregistrée dans C:/"

C'est possible à faire?

A+

Le 11/08/2013 à 17:12

Bonjour

A tester

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, MyFile As String

  SaveAsUI = False
  Cancel = True
  With Worksheets("Akisti Bat")
    Select Case Left(.Range("H10"), 1)
      Case "B": Chemin = "C:\Akisti Bat\Bon de Commande\"
      Case "D": Chemin = "C:\Akisti Bat\Devis\"
      Case "F": Chemin = "C:\Akisti Bat\Factures\"
    End Select
    MyFile = Chemin & .Range("H10") & .Range("I10") & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("G14") & ")" & ".xlsm"
  End With

 If Dir(Chemin, vbDirectory) = "" Then
    MsgBox "Le répertoire " & Chemin & " n'existe pas"
    Exit Sub
  End If

  If Dir(MyFile) <> "" Then
    If MsgBox("Un fichier nommé '" & MyFile & "' existe déjà à cet emplacement" & vbCr & _
              "Voulez-vous le remplacer ?", vbInformation + vbYesNo + vbDefaultButton2, Application.UserName) <> vbYes Then
      MsgBox "Fichier non enregistré"
      Exit Sub
    End If
  End If

  Application.EnableEvents = False
  Application.DisplayAlerts = False
  Me.SaveAs MyFile
  Application.DisplayAlerts = False
  Application.EnableEvents = True
  MsgBox "La facture ou le devis a bien été enregistrée !"
End Sub
Le 11/08/2013 à 17:15

Je teste de suite

Tu as vu mon post précédant ?

Merci encore Banzai64

Le 11/08/2013 à 18:33

Bonjour

On ne peut pas enregistrer dans la racine d'un lecteur

regardes ici http://support.microsoft.com/kb/923917/fr (fait pour Word mais Excel c'est la même chose - du moins je crois)

Je ne connais pas la solution pour passer outre (liberté chérie où es tu ?)

Essayes cette modification

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, MyFile As String

  SaveAsUI = False
  Cancel = True
  With Worksheets("Akisti Bat")
    Select Case Left(.Range("H10"), 1)
      Case "B": Chemin = "C:\Akisti Bat\Bon de Commande\"
      Case "D": Chemin = "C:\Akisti Bat\Devis\"
      Case "F": Chemin = "C:\Akisti Bat\Factures\"
    End Select
    If Dir(Chemin, vbDirectory) = "" Then
      MsgBox "Le répertoire " & Chemin & " n'existe pas" & vbCr & vbCr & vbCr & "Il sera remplacé par ""C:\Users\" & Application.UserName & "\Documents\"""
      Chemin = "C:\Users\" & Application.UserName & "\Documents\"
    End If
    MyFile = Chemin & .Range("H10") & .Range("I10") & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("G14") & ")" & ".xlsm"
  End With

  If Dir(MyFile) <> "" Then
    If MsgBox("Un fichier nommé '" & MyFile & "' existe déjà à cet emplacement" & vbCr & _
              "Voulez-vous le remplacer ?", vbInformation + vbYesNo + vbDefaultButton2, Application.UserName) <> vbYes Then
      MsgBox "Fichier non enregistré"
      Exit Sub
    End If
  End If

  Application.EnableEvents = False
  Application.DisplayAlerts = False
  Me.SaveAs MyFile
  Application.DisplayAlerts = False
  Application.EnableEvents = True
  MsgBox "La facture ou le devis a bien été enregistrée !"
End Sub
Le 11/08/2013 à 19:26

Re,

C'est pas trop grave, je peux m'en passer

Merci pour le code Banzai64

Dernière question puis je te laisse tranquille

Dans G1 j'ai crée une liste déroulante :

DEVIS;FACTURE;SITUATION SELON DEVIS

Puis dans H10 j'ai mis une formule : =SI(G1<>"";NOMPROPRE(G1)&" N°";"")

Au fait ça permet de mettre la première lettre en majuscule puis le reste en minuscule,

Le problème est qu'à partir du moment ou je sélectionne "SITUATION SELON DEVIS" dans la liste déroulante

dans H10 il me l'écrit : "Situation Selon Devis N°"

J'aimerais l'écrire comme ceci :

"Situation selon devis N°"

C'est possible?

a+

Le 11/08/2013 à 20:50

Bonsoir

Ronibo a écrit :

C'est possible?

Oui

=SI(G1<>"";MAJUSCULE(GAUCHE(G1;1)) & MINUSCULE(STXT(G1;2;100))&" N°";"")
Le 11/08/2013 à 20:56

Re,

Parfait !

Merci pour tout Banzai64

A+

Rechercher des sujets similaires à "methode copy classe range echoue"