ExcelマクロExcelシートからテーブルをコピーしてPowerPointに貼り付けるにはflexibiltyを使用します。どのcolomunsと行をdicedeにしますか？

Question

Excelテーブルをコピーしてパワーポイントのスライドに貼り付けます。ユーザーは、どの列と行を移植するか、つまりどの列と行をppt表に変換するかを決定できるはずです。私が今までに得たことは、テーブル全体をコピーして貼り付けることですが、ユーザーにこの列と行を選択する柔軟性を与えることに成功しませんでした。そしてそれは私が書いたものだ：

Sub ExcelRangeToPowerPoint() 

Dim rng As Range 
Dim PowerPointApp As Object 
Dim myPresentation As Object 
Dim mySlide As Object 
Dim myShape As Object 

Set rng = ThisWorkbook.ActiveSheet.Range("A1:J62") 

On Error Resume Next 

'Is PowerPoint already opened? 
Set PowerPointApp = GetObject(class:="PowerPoint.Application") 

'Clear the error between errors 
Err.Clear 

'If PowerPoint is not already open then open PowerPoint 
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application") 

'Handle if the PowerPoint Application is not found 
If Err.Number = 429 Then 
    MsgBox "PowerPoint could not be found, aborting." 
    Exit Sub 
End If 

On Error GoTo 0 

'Optimize Code 
Application.ScreenUpdating = False 

'Create a New Presentation 
Set myPresentation = PowerPointApp.Presentations.Add 

'Add a slide to the Presentation 
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly 

'Copy Excel Range 
rng.Copy 

'Paste to PowerPoint and position 
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile 
Set myShape = mySlide.Shapes(mySlide.Shapes.Count) 

'Set position: 
myShape.Left = 10 
myShape.Top = 10 

'Make PowerPoint Visible and Active 
PowerPointApp.Visible = True 
PowerPointApp.Activate 

'Clear The Clipboard 
Application.CutCopyMode = False 

End Sub 

あなたは私を助けることができる、この問題を解決してください？

ありがとう！

Answer 1

以下のセクションでは、エクスポートする行の数（行1を開始）と列の数（列Aを開始する）を選択する例を示します。必要なものに展開できます。右 `、：

Sub ExcelRangeToPowerPoint() 

Dim rng As Range 
Dim PowerPointApp As Object 
Dim myPresentation As Object 
Dim mySlide As Object 
Dim myShape As Object 
Dim NumofCols As Variant 
Dim NumofRows As Variant 

' select number of rows to export 
NumofRows = InputBox("Select number of rows you want to export from table (up to 62)") 
If Not IsNumeric(NumofRows) Then 
    MsgBox "Please select a valid Numeric value !", vbCritical 
    End 
Else 
    NumofRows = CLng(NumofRows) 
End If 

' select number of columns you want to expot 
NumofCols = InputBox("Select number of columns you want to export from table (up to 10)") 
If Not IsNumeric(NumofCols) Then 
    MsgBox "Please select a valid Numeric value !", vbCritical 
    End 
Else 
    NumofCols = CLng(NumofCols) 
End If 

' set the Range starting fro Cell A1 >> you can modify it as you want 
Set rng = ThisWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(NumofRows, NumofCols)) 

On Error Resume Next 

'Is PowerPoint already opened? 
Set PowerPointApp = GetObject(class:="PowerPoint.Application") 

'Clear the error between errors 
Err.Clear 

'If PowerPoint is not already open then open PowerPoint 
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application") 

'Handle if the PowerPoint Application is not found 
If Err.Number = 429 Then 
    MsgBox "PowerPoint could not be found, aborting." 
    Exit Sub 
End If 

On Error GoTo 0 

'Optimize Code 
Application.ScreenUpdating = False 

'Create a New Presentation 
Set myPresentation = PowerPointApp.Presentations.Add 

'Add a slide to the Presentation 
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly 

'Copy Excel Range 
rng.Copy 

'Paste to PowerPoint and position 
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile 
Set myShape = mySlide.Shapes(mySlide.Shapes.Count) 

'Set position: 
myShape.Left = 10 
myShape.Top = 10 

'Make PowerPoint Visible and Active 
PowerPointApp.Visible = True 
PowerPointApp.Activate 

'Clear The Clipboard 
Application.CutCopyMode = False 

End Sub