Sub SetPageSameAsSelected()
Dim sr As ShapeRange, s As Shape
Dim x#, y#, w#, h#
ActiveDocument.BeginCommandGroup ("pagesize")
ActiveDocument.Unit = cdrMillimeter
Set sr = ActiveSelectionRange
If sr.Count = 0 Then Exit Sub
sr.GetBoundingBox x, y, w, h
ActivePage.SetSize w + 5, h + 5
sr.AlignRangeToPageCenter (cdrAlignVCenter)
ActiveDocument.EndCommandGroup
End Sub

Enabling tracing for 60 seconds...
Observing system behavior...
Analyzing trace data...
Analysis complete.

Energy efficiency problems were found.

7 Errors
11 Warnings
88 Informational

   // Disable Windows Screen Flicker Bug Fix on newer versions
var winFlickerFix = !/mac/i.test($.os) && parseFloat(app.version) < 26.4;

if (winFlickerFix) {
  simulateKeyPress('TAB', 1);
} else {
  element.active = true;
}

function simulateKeyPress(k, n) {
  if (!/win/i.test($.os)) return false;
  if (!n) n = 1;
  try {
    var f = new File(Folder.temp + '/' + 'SimulateKeyPress.vbs');
    var s = 'Set WshShell = WScript.CreateObject("WScript.Shell")\n';
    while (n--) {
      s += 'WshShell.SendKeys "{' + k.toUpperCase() + '}"\n';
    }
    f.open('w');
    f.write(s);
    f.close();
    f.execute();
  } catch(e) {}
}