Set pptPres = pptAppl.Presentations.Add
    For Each wksQ In wbkQ.Worksheets
        If Application.WorksheetFunction.CountA(wksQ.Cells) > 0 Then
 
            Set rngB = wksQ.UsedRange
            Set pptSld = pptPres.Slides.Add(pptPres.Slides.Count + 1, _
              ppLayoutBlank)
            rngB.CopyPicture
            pptSld.Shapes.Paste
            pptSld.Shapes(1).Top = (pptAppl.Height - pptSld.Shapes(1).Height) / _
              2 'PP zentriert
            pptSld.Shapes(1).Left = (pptAppl.Width - pptSld.Shapes(1).Width) / _
            2  'PP zentriert
        End If
 
    Next