Sub InspectTableStructure()
    Dim pres As Object
    Dim slide As Object
    Dim tableShape As Object
    Dim row As Integer
    Dim col As Integer
    Dim cellText As String
    
    
    Set pres = Application.ActivePresentation

    
    Set slide = pres.Slides(1)

   
    Set tableShape = Nothing
    Dim shp As Object
    For Each shp In slide.Shapes
        If shp.HasTable Then
            Set tableShape = shp
            Exit For
        End If
    Next shp

    If tableShape Is Nothing Then
        MsgBox "No table found on the slide!", vbExclamation
        Exit Sub
    End If

   
    Debug.Print "Inspecting table structure:"
    Debug.Print "Total rows: " & tableShape.Table.Rows.Count

    For row = 1 To tableShape.Table.Rows.Count
        Debug.Print "Row " & row & ":"
        
      
        For col = 1 To tableShape.Table.Rows(row).Cells.Count
            On Error Resume Next
            cellText = tableShape.Table.Cell(row, col).Shape.TextFrame.TextRange.Text
            If Err.Number = 0 Then
                Debug.Print "    Column " & col & " - Text: " & cellText
            Else
                Debug.Print "    Column " & col & " - Error: Cell not accessible."
            End If
            On Error GoTo 0
        Next col
    Next row

    MsgBox "Table structure inspection complete! Check the Immediate Window (Ctrl+G) for details.", vbInformation
End Sub

Sub PopulateExistingTable()
    Dim pptApp As Object
    Dim pres As Object
    Dim slide As Object
    Dim tableShape As Object
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim excelSheet As Object
    Dim row As Integer
    Dim tableRow As Integer
    Dim tableColumn As Integer

   
    Dim excelFilePath As String
    excelFilePath = "F:\31.12.2024\combine\MyData1.xlsx" 

   
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = False
    Set excelWorkbook = excelApp.Workbooks.Open(excelFilePath)
    Set excelSheet = excelWorkbook.Sheets(1)

 
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True

  
    If pptApp.Presentations.Count > 0 Then
        Set pres = pptApp.ActivePresentation
    Else
        MsgBox "No PowerPoint presentation is open!", vbExclamation
        Exit Sub
    End If

   
    row = 2 
    Do While excelSheet.Cells(row, 1).Value <> ""
        
        Dim newSlide As Object
        Set newSlide = pres.Slides(1).Duplicate 
        newSlide.MoveTo pres.Slides.Count      

        
        Set slide = pres.Slides(pres.Slides.Count)

     
        Set tableShape = Nothing
        Dim shp As Object
        For Each shp In slide.Shapes
            If shp.HasTable Then
                Set tableShape = shp
                Exit For
            End If
        Next shp

        If Not tableShape Is Nothing Then
            
            tableShape.Table.Cell(1, 12).Shape.TextFrame.TextRange.Text = excelSheet.Cells(row, 4).Value
           
           
        Else
            MsgBox "No table found on the slide!", vbExclamation
            Exit Sub
        End If



'-----------------------------------------
      imagePath = excelSheet.Cells(row, 23).Value 
        If Len(imagePath) > 0 And Dir(imagePath) <> "" Then
          
            On Error Resume Next
            Set imageRectangle = slide.Shapes("ImageRectangle")
            On Error GoTo 0
            
            If Not imageRectangle Is Nothing Then
             
                imageRectangle.Fill.UserPicture imagePath
            Else
                MsgBox "Rectangle shape not found!", vbExclamation
            End If
        Else
            MsgBox "Invalid image path for row " & row, vbExclamation
        End If
     
'-----------------------------------------
        row = row + 1
    Loop

 
    excelWorkbook.Close False
    excelApp.Quit


    Set excelSheet = Nothing
    Set excelWorkbook = Nothing
    Set excelApp = Nothing

    MsgBox "Slides created and populated successfully!", vbInformation
End Sub