XL 2016 Copie tableau excel à Powerpoint case par case VBA

[BoudinTozz]

Bonjour à tous.

Tout d'abord merci de me lire, j'ai longtemps cherché la solution à mon problème sur le forum mais je n'ai rien trouvé qui fonctionne...

J'ai un code VBA qui doit me servir à recopier certaines cases d'un tableau Excel dans des tableaux associés dans Powerpoint. Le problème est que cette copie doit se faire case par case et que certaines contiennent des liens hypertexte que je souhaite garder. J'imagine que c'est ce qui pose problème dans mon code.

Ci dessous le code complet, mais la partie qui nous intéresse se trouve à la ligne 41.


Merci d'avance pour votre temps.


Ps: J'ai testé toutes les conditions qui entourent la copie, elles fonctionnent correctement, je pense que le problème peut-être résolu sans s'intéresser à ça

Public Sub MisaAJour()
    ' déclaration
    Dim objSld As Slide
    Dim wb As Excel.Workbook
    Dim source As Excel.Worksheet
    Dim tabname As String
    Dim xlApp As Object
    Dim l As Integer
    Dim k As Integer
    Dim m As Integer
  
    Set xlApp = CreateObject("excel.application")

    xlApp.Workbooks.Open ("c:\chemindudoc.xlsm")
    Set wb = xlApp.ActiveWorkbook
    xlApp.Visible = True
    Set source = wb.Worksheets("NomduSheet")
  
      
    For k = 7 To 18
  
      Set objSld = ActivePresentation.Slides(k) 'affectations
    
      tabname = ("Table" & k)
  
          For l = 1 To 2    ' pour boucler sur les colonnes
            m = 2
            source.Range("F6").Activate
            While ActiveCell.Value <> k ' atteint la bonne catégorie
                ActiveCell.Offset(1, 0).Select
            Wend
            While (ActiveCell.Value = k Or ActiveCell.Value = "") ' pour boucler sur les lignes jusqu'a la fin de la catégorie
              
                If source.Cells(ActiveCell.Row, 9) = "Yes" Then 'Si la case "In portal" vaut "yes"
                  
                    If objSld.Shapes(tabname).Table.Rows.Count = (m) Then 'ajoute une ligne si besoin
                        objSld.Shapes(tabname).Table.Rows.Add
                    End If
                  
                    source.Cells(ActiveCell.Row, l + 3).Select
                    Selection.Copy
                    objSld.Shapes(tabname).Table.Cell(m, l).PasteSpecial ppPasteOLEObject

                  
                    m = m + 1
                End If
                ActiveCell.Offset(1, 0).Select
            Wend
          Next l
    Next k
  
    wb.Close False
    MsgBox ("Success")
End Sub