パワーポイントにカスタムフィギュアをマージする

Question

私はパワーポイントでアメリカのマップを作成するカスタムを持っています。

Sub ArrayLoop(array1, array2, amountOfLine) 


Dim i As Long 
For i = 0 To amountOfLine 
With ActivePresentation.Slides(1).Shapes.AddLine(BeginX:=array1(i), BeginY:=array2(i), EndX:=array1(i + 1), EndY:=array2(i + 1)).Line 
    .DashStyle = msoLineDashDotDot 
    .ForeColor.RGB = RGB(50, 0, 128) 
End With 
Next 
End Sub 


Sub TestArrayLoop() 

Dim USA1, USA2 
Dim amount As Integer 

USA1 = Array(316.0954, 321.021, 332.9831, 337.205, 337.205, 346.4698, 
351.3953, 354.9135, 361.9501, 367.5793, 370.394, 371.8012, 374.6158, 376.7268, 
375.3195, 376.7268, 383.0596, 385.1706, 378.8377, 376.0232, 378.1341, 
378.8377, 368.9866, 364.061, 366.172, 371.0976, 373.9122, 382.356, 388.6888, 
393.6144, 397.1327, 394.318, 393.6144, _ 
384.4669, 384.4669, 376.7268, 374.6158, 369.6902, 368.2829, 366.172, 
366.172, 
361.9501, 358.4318, 354.9135, 350.6917, 347.8771, 347.8771, 347.8771, 
347.1734, 346.4698, 350.6917, 343.6551, 345.0624, 342.2478, 339.4332, 
337.9087, 
330.8721, 317.5027, 314.6881, 312.5772, 310.4662, 316.0954, 319.6137, 
323.132, 325.2429, 327.3539, 328.7612, 335.7977, 339.4332, 337.205, 
338.7296, 
335.7977, 331.5757, 330.1685, 325.9465, 324.5393, 322.4283, 319.6137, 
318.2064, 315.3918, 313.9845, 309.7626, 306.2443, 306.2443, 311.1698, 
311.8735, 
308.3553, 306.2443, 303.4297, 302.0224, 297.0969, 290.0603, 285.8384, 279.5055, 280.2092, 280.9128, 278.8019, 275.2836, 267.5435, 264.0252, 265.4325, 
260.5069, 254.8777, 247.1376, 242.212, 237.2865, 223.917, 220.3988, 214.7696, 211.2513, 206.9121, 206.9121, 214.0659, 219.6951, 227.4353, 232.3609, 
231.6572, 233.7682, 239.3974, 247.1376, 247.8412, 309.0589, 316.0954) 

USA2 = Array(247.1064, 248.5467, 254.3079, 263.6699, 267.9909, 265.1102, 260.7893, 260.0691, 258.6288, 251.4273, 252.1475, 259.349, 257.1885, 257.9087, 
260.0691, 262.9498, 257.9087, 255.028, 254.3079, 249.987, 247.8265, 244.9459, 247.1064, 251.4273, 246.3862, 243.5056, 240.625, 241.3451, 240.625, 
237.0242, 234.1435, 226.942, 223.3412, 218.3002, 215.4195, 200.2962, 206.7776, 208.218, 206.7776, 206.7776, 196.5754, 195.8553, 190.8142, 191.5343, 
190.094, 190.8142, 194.415, 198.1357, 206.0575, 208.9381, 217.58, 224.0613, 234.8637, 237.0242, 235.5839, 222.621, 221.9009, 213.9792, 213.9792, 207.4978, 
205.3373, 187.9335, 184.3327, 182.1723, 182.1723, 174.9708, 169.2095, 
167.7692, _ 
164.8886, 158.4072, 154.0862, 150.4854, 149.7653, 156.9669, 163.4483, 155.5265, 152.6459, 156.2467, 152.6459, 147.6049, 141.1235, 133.9219, 144.0041, 
147.6049, 151.9258, 156.2467, 159.8475, 158.4072, 158.4072, 162.0079, 160.5676, 160.5676, 157.687, 159.1273, 161.2878, 165.6087, 164.8886, 160.5676, 
162.0079, 159.1273, 156.2467, 154.8064, 151.9258, 149.7653, 151.2056, 145.4444, 151.9258, 155.5265, 154.0862, 150.4854, 149.0452, 200.2962, 203.897, 
201.0164, 215.4195, 219.0203, 224.7815, 229.1024, 237.0242, 242.0653, 245.6661, 245.6661, 247.1064) 


amount = UBound(USA1) - LBound(USA2) + 1 
amount = amount - 2 
ArrayLoop USA1, USA2, amount 
End Sub 

これはすべて正常に機能しますが、今は全体の図形を選択できません。だから私は方法を探して、私はそれを私は画面の周りにドラッグすることができる図形をマージします。

どうすればいいですか？好ましくはVBAで

Answer 1

多くの個別の行を追加することが主な問題です。あなたが想像するようにコードを動作させるためには、何らかの形でシェイプを1行に追加する必要があります。これを行うには、ここからあなたのサブを変更します。これに

Sub ArrayLoop(array1, array2, amountOfLine) 
    Dim i As Long 

    For i = 0 To amountOfLine 
     With ActivePresentation.Slides(1).Shapes.AddLine(BeginX:=array1(i), BeginY:=array2(i), EndX:=array1(i + 1), EndY:=array2(i + 1)).Line 
     .DashStyle = msoLineDashDotDot 
     .ForeColor.RGB = RGB(50, 0, 128) 
     End With 
    Next 
End Sub 

を：

Sub ArrayLoop(array1, array2) 
    'you will need a single array of points for the call. 
    'whether you want to pass in 2 arrays and then merge them 
    'or pass in a single merged array is up to you 

    With ActivePresentation.Slides(1).Shapes.AddPolyline(<an array of points>).Line 
     .DashStyle = msoLineDashDotDot 
     .ForeColor.RGB = RGB(50, 0, 128) 
    End With 
End Sub 

あなたはこの作業を取得するためのポイントのあなたの配列を微調整する必要があります。