Erreur d'execution "13" incompatibilité de type

Le 17/12/2020 à 11:08

Bonjour chers tous

je suis confronté à une erreur dans mon code que je ne comprends pas: Erreur d'execution "13" incompatibilité de type

Comment regler ce probleme ?

MERCI

capture d ecran
Le 17/12/2020 à 11:19

Bonjour,

Vu le petit bout de code .... pas sur de la réponse ; donc sauf si vous avez déclaré "Cel" comme variable

l'écriture c'est plutôt :

For Each Cell
Le 17/12/2020 à 11:35

En debut de macro il y'a Dim cel as range

Le 17/12/2020 à 11:56

Personnellement je déclarerai plutôt la plage en variable.

Dim Cell as range
Dim Maselection as range
Set Maselection =Range("H4:H" & Range("H66999").End(xlUp).Row)

For Each Cell in Maselection
if Cell.value="Stable" then
....
Le 17/12/2020 à 12:12

Bonjour,

En debut de macro il y'a Dim cel as range

Vous avez bien un WITH avant la première ligne ?

Montrez le code complet ou tout au moins le code avant les lignes que vous avez postées

Crdlt

Le 17/12/2020 à 13:55

Voici le code complet

Sub SAVE_RDV_ATTENDUS()

Dim dossier$
Dim Chemin As String, P, p1, cel As Range, x As Variant, dl As Long
Dim F, w As Worksheet, fichier$, periode$

Application.ScreenUpdating = False
    Chemin = ThisWorkbook.Path & "\RDV_PREVUS\"
    If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin
    fichier = Month(Sheets("TB").Range("B11")) & "-" & "Liste des RDV" & " " & Sheets("TB").Range("B8") & "" & Format(Sheets("TB").Range("B11"), " mmmm yyyy")
    periode = Format(Sheets("TB").Range("B11"), " mmmm yyyy") & "  " & Sheets("TB").Range("B8")
    Application.ScreenUpdating = False
    Set F = ActiveWorkbook.Worksheets("RDV")
    With F
        .Visible = True
        .Unprotect "2580"
    End With
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Workbooks.Add (xlWBATWorksheet)
    Application.EnableEvents = True
With ActiveWorkbook
Application.ScreenUpdating = False
        F.Range("A3:J" & F.Range("A" & Rows.Count).End(xlUp).Row + 1).Copy Destination:=.Worksheets(1).Cells(3, 2)
        Application.CutCopyMode = False
        ActiveWindow.DisplayGridlines = False
    Application.ScreenUpdating = False
    With .Sheets(1)
    Application.ScreenUpdating = False
    dl = .Range("B" & Rows.Count).End(xlUp).Row
     .Range("B3").Copy
    .Range("A3:K3").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    .Range("B4:K" & dl).Sort key1:=.Range("J4"), order1:=xlDescending
    .Range("A3").FormulaR1C1 = "N°"
    .Range("A4").Value = dl - 3
    If dl > 4 Then
    .Range("A5:A" & dl).FormulaR1C1 = "=R[-1]C-1"
    .Range("A4:A" & dl).Value = .Range("A4:A" & dl).Value
    .Range("A4:K" & dl).Sort key1:=.Range("A4"), order1:=xlAscending
    End If
    .PageSetup.Zoom = False
    .Cells(1).Select
    .Columns("A:K").AutoFit
    .Range("$A$1:$K$" & dl).Font.Name = "Arial Narrow"
    .Range("$A$1:$K$" & dl).Font.Size = 12
    .Range("$A$4:$K$" & dl).Font.Bold = False
    .[A1] = "RENDEZ_VOUS ATTENDUS DU MOIS DE " & " " & periode
    .Range("$A$1:$K$1").MergeCells = True
    .Range("$A$1:$K$1").Font.Bold = True
    .Range("$A$1:$K$1").HorizontalAlignment = xlCenter
    .Range("$A$1:$K$1").VerticalAlignment = xlCenter
    .Range("A3").Copy
    .Range("$A$4:$A$" & dl).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    .PageSetup.Zoom = False
    .PageSetup.PrintArea = .Range("$A$1:$K$" & dl).Address
    .PageSetup.Orientation = xlPortrait
    .PageSetup.FitToPagesTall = 1
    .PageSetup.FitToPagesWide = False
    .PageSetup.RightFooter = "&P de &N"
    .PageSetup.LeftMargin = Application.InchesToPoints(0.118110236220472)
    .PageSetup.RightMargin = Application.InchesToPoints(0.118110236220472)
    .Range("A3:K" & .Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous
    .Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).HorizontalAlignment = xlCenter
    .Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).VerticalAlignment = xlCenter
    .Range("C3:K" & .Range("A" & Rows.Count).End(xlUp).Row).HorizontalAlignment = xlCenter
    .Range("C3:K" & .Range("A" & Rows.Count).End(xlUp).Row).VerticalAlignment = xlCenter
    .Range("C4:C" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "dd-mmm-yy"
    .Range("J4:J" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "dd-mmm-yy"
    .Range("E4:E" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
    .Range("I4:I" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
    .Range("K4:K" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
    .Cells(1).Select
    For Each cel In .Range("H4:H" & .Range("H" & Rows.Count).End(xlUp).Row)
            If cel.Value = "Stable" Then .Range("A" & cel.Row & ":K" & cel.Row).Font.Bold = True
    Next cel
    End With
                     Application.ScreenUpdating = False
                     Application.DisplayAlerts = False
.SaveAs Chemin & fichier, 51
.Close
End With
    F.Visible = False
Set F = Nothing

End Sub
Le 17/12/2020 à 14:09

Bonjour KTM,

Tu peux essayer comme ça 

Sub SAVE_RDV_ATTENDUS()
  Dim dossier$
  Dim Chemin As String, P, p1, Cel As Range, x As Variant, dl As Long
  Dim Wbk As Workbook, F As Worksheet, F1 As Worksheet, fichier$, periode$

  Application.ScreenUpdating = False
  Chemin = ThisWorkbook.Path & "\RDV_PREVUS\"
  If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin
  fichier = Month(Sheets("TB").Range("B11")) & "-" & "Liste des RDV" & " " & Sheets("TB").Range("B8") & "" & Format(Sheets("TB").Range("B11"), " mmmm yyyy")
  periode = Format(Sheets("TB").Range("B11"), " mmmm yyyy") & "  " & Sheets("TB").Range("B8")
  Application.ScreenUpdating = False
  Set F = ActiveWorkbook.Worksheets("RDV")
  With F
    .Visible = True
    .Unprotect "2580"
  End With
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Set Wbk = Workbooks.Add(xlWBATWorksheet)
  Application.EnableEvents = True
  ' Définir la feuille du nouveau classeur
  Set F1 = Wbk.Sheets(1)
  Application.ScreenUpdating = False
  F.Range("A3:J" & F.Range("A" & Rows.Count).End(xlUp).Row + 1).Copy Destination:=F1.Cells(3, 2)
  Application.CutCopyMode = False
  ActiveWindow.DisplayGridlines = False
  Application.ScreenUpdating = False
  dl = F1.Range("B" & Rows.Count).End(xlUp).Row
  F1.Range("B3").Copy
  F1.Range("A3:K3").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                                 SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  F1.Range("B4:K" & dl).Sort key1:=F1.Range("J4"), order1:=xlDescending
  F1.Range("A3").FormulaR1C1 = "N°"
  F1.Range("A4").Value = dl - 3
  If dl > 4 Then
    F1.Range("A5:A" & dl).FormulaR1C1 = "=R[-1]C-1"
    F1.Range("A4:A" & dl).Value = F1.Range("A4:A" & dl).Value
    F1.Range("A4:K" & dl).Sort key1:=F1.Range("A4"), order1:=xlAscending
  End If
  F1.PageSetup.Zoom = False
  F1.Columns("A:K").AutoFit
  With F1.Range("$A$1:$K$" & dl)
    With .Font
      .Name = "Arial Narrow"
      .Size = 12
      .Bold = False
    End With
  End With
  F1.[A1] = "RENDEZ_VOUS ATTENDUS DU MOIS DE " & " " & periode
  With F1.Range("$A$1:$K$1")
    .MergeCells = True
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
  End With
  F1.Range("A3").Copy
  F1.Range("$A$4:$A$" & dl).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                                         SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  With F1.PageSetup
    .Zoom = False
    .PrintArea = F1.Range("$A$1:$K$" & dl).Address
    .Orientation = xlPortrait
    .FitToPagesTall = 1
    .FitToPagesWide = False
    .RightFooter = "&P de &N"
    .LeftMargin = Application.InchesToPoints(0.118110236220472)
    .RightMargin = Application.InchesToPoints(0.118110236220472)
  End With
  F1.Range("A3:K" & F1.Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous
  F1.Range("A3:A" & F1.Range("A" & Rows.Count).End(xlUp).Row).HorizontalAlignment = xlCenter
  F1.Range("A3:A" & F1.Range("A" & Rows.Count).End(xlUp).Row).VerticalAlignment = xlCenter
  F1.Range("C3:K" & F1.Range("A" & Rows.Count).End(xlUp).Row).HorizontalAlignment = xlCenter
  F1.Range("C3:K" & F1.Range("A" & Rows.Count).End(xlUp).Row).VerticalAlignment = xlCenter
  F1.Range("C4:C" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "dd-mmm-yy"
  F1.Range("J4:J" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "dd-mmm-yy"
  F1.Range("E4:E" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
  F1.Range("I4:I" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
  F1.Range("K4:K" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
  For Each Cel In F1.Range("H4:H" & F1.Range("H" & Rows.Count).End(xlUp).Row)
    If Cel.Value = "Stable" Then F1.Range("A" & Cel.Row & ":K" & Cel.Row).Font.Bold = True
  Next Cel
  Wbk.SaveAs Chemin & fichier, 51
  Wbk.Close
  F.Visible = False
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Set Wbk = Nothing: Set F = Nothing: Set F1 = Nothing
End Sub

@+

Le 17/12/2020 à 14:13

Vous êtes sur la feuille 1 lorsque l'erreur se produit. Voir donc dans cette feuille si c'est la bonne feuille

Juste un truc votre variable F doit être déclarée --> Dim F as worksheet.

Là vous avez Dim F, F est donc Variant et pas worksheet

Sinon j'aurais plutot essayé de découper le code en plusieurs macros car là pour lire ....

Cordialement

edit : oups Bruno, désolé je viens de voir que tu avais répondu...

Rechercher des sujets similaires à "erreur execution incompatibilite type"