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

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 imagePath As String
Dim imageRectangle As Object

Dim excelFilePath As String
excelFilePath = "d:\mergedata\MDatay.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 <> ""
    Set slide = pres.Slides(1).Duplicate

    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(2, 1).Shape.TextFrame.TextRange.Text = excelSheet.Cells(row, 1).Value
        tableShape.Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = excelSheet.Cells(row, 2).Value
    Else
        MsgBox "No table found on the slide!", vbExclamation
        Exit Sub
    End If

    imagePath = excelSheet.Cells(row, 3).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