Problème macro et de paste sur Excel 365

Bonsoir forum,

J'ai une macro qui fonctionne bien sur excel 2007 mais visiblement moins sur excel 365, donc je me demande bien ce qui peux coincer

La macro copie colle deux images dans un nouvel onglet.

Votre aide est la bienvenue merci

6test.xlsm (27.69 Ko)

ça c'est bug sur la 2ème image sur 365

bug

Bonjour,

Sub CreerUnOngletAvecLogoEtSignature()

Dim WsSource As Worksheet, WsNouvelOnglet As Worksheet, WsSignature As Worksheet, WsLogo As Worksheet
Dim OngletName As String
Dim MyLogo As Shape, MySignature As Shape

    On Error GoTo Fin

    Application.ScreenUpdating = False

    With ThisWorkbook
         Set WsSource = .Sheets("Feuil1")
         Set WsLogo = .Sheets("Logo")
         Set WsNouvelOnglet = .Sheets.Add(after:=Sheets(Sheets.Count))  ' Crée un nouvel onglet
    End With

    With WsLogo
         Set MyLogo = .Shapes("Image 1")      ' Référence l'image dans la feuille
         Set MySignature = .Shapes("Image 2")
    End With

    With WsNouvelOnglet
         OngletName = WsSource.Range("E2")
         .Name = OngletName & " " & Format(NumeroOnglet(OngletName), "00") ' Utilise le nom extrait comme nom de l'onglet
         .Tab.Color = RGB(0, 255, 0) ' Vert  ' Colore l'onglet
    End With

    MyLogo.Copy           ' Copie l'image du logo dans la feuille active (wsNouvelOnglet)
    With WsNouvelOnglet   ' Colle le logo à la position souhaitée
         .Pictures.Paste
         With .Shapes(1)
              .LockAspectRatio = msoTrue
              .Left = 595
              .Top = 10
         End With
    End With
    Application.CutCopyMode = False  ' Efface le presse-papiers (pour éviter les problèmes)

    MySignature.Copy    ' Copie l'image de la signature dans la feuille active (wsNouvelOnglet)
    With WsNouvelOnglet ' Colle la signature à la position souhaitée
         .Pictures.Paste
         With .Shapes(2)
              .LockAspectRatio = msoTrue
              .Left = 70
              .Top = 100
         End With
    End With
    Application.CutCopyMode = False

    GoTo Fin

Fin:

    Set WsSource = Nothing: Set WsNouvelOnglet = Nothing: Set WsLogo = Nothing
    Set WsSignature = Nothing: Set MyLogo = Nothing: Set MySignature = Nothing

    Application.ScreenUpdating = True

End Sub

Function NumeroOnglet(ByVal NomOnglet As String) As Integer

Dim I As Integer

    NumeroOnglet = 1
    For I = 1 To Sheets.Count
        If InStr(1, Sheets(I).Name, NomOnglet, vbTextCompare) > 0 Then
           NumeroOnglet = NumeroOnglet + 1
        End If
    Next I

End Function

Merci beaucoup, ça fonctionne

Rechercher des sujets similaires à "probleme macro paste 365"