vba - Copy and paste rows from Excel to Powerpoint -


ok, here looking (im new, gentle):

  • copy , paste (default format) excel powerpoint (from 1 sheet)
  • i can fit many rows in ppt - after slide fills, want ppt create new slide
  • same title each slide fine!
  • i need columns b:k copied over

that's it, stuck :( know below code not best way write , contains errors in sure easy spot. cannot find how anywhere on net.

this have far:

sub excelrangetopowerpoint() dim rng excel.range dim powerpointapp powerpoint.application dim mypresentation powerpoint.presentation dim myslide powerpoint.slide dim myshaperange powerpoint.shape dim integer  'create instance of powerpoint   on error resume next  'is powerpoint opened?   set powerpointapp = getobject(class:="powerpoint.application")  'clear error between errors   err.clear  'if powerpoint not open open powerpoint   if powerpointapp nothing set powerpointapp = createobject(class:="powerpoint.application")  'make powerpoint visible , active   powerpointapp.visible = true   powerpointapp.activate  'create new presentation   set mypresentation = powerpointapp.presentations.add  'add slide presentation   set myslide = mypresentation.slides.add(1, pplayouttitleonly)   = 1 6   'need set focus slde 1    powerpointapp.activewindow.view.gotoslide (1)    'deletes title   'myslide.shapes.title.delete    'builds new title   myslide.shapes.addshape type:=msoshaperectangle, left:=9, top:=6, width:=702, height:=30   myslide.shapes(myslide.shapes.count).line.visible = msotrue   myslide.shapes(myslide.shapes.count).textframe.textrange.font.size = 20   myslide.shapes(myslide.shapes.count).textframe.textrange.font.color.rgb = rgb(0, 0, 0)   myslide.shapes(myslide.shapes.count).textframe.textrange.paragraphformat.alignment = ppalignleft   myslide.shapes(myslide.shapes.count).textframe.textrange.text = "current full initiative details – branded book of " & date   myslide.shapes(myslide.shapes.count).name = "i title"   myslide.shapes(myslide.shapes.count).line.forecolor.rgb = rgb(0, 0, 0)   myslide.shapes(myslide.shapes.count).line.weight = 1   myslide.shapes(myslide.shapes.count).fill.visible = msotrue   myslide.shapes(myslide.shapes.count).fill.forecolor.rgb = rgb(255, 255, 255)    'copy range excel   set rng = activeworkbook.worksheets("raw").range("b1:k23")    'copy excel range   rng.copy    'paste powerpoint , position   powerpointapp.activewindow.view.pastespecial datatype:=pppastedefault    set myshaperange = myslide.shapes(myslide.shapes.count)    'set position:   myshaperange.left = 10   myshaperange.top = 42   myshaperange.height = 492   myshaperange.width = 702    activeworkbook.sheets("raw").rows("2:23").delete    call mypresentation.slides.add(1, ppslidelayout.pplayouttitleonly)    'clear clipboard   application.cutcopymode = false  next  end sub 

as requested in comments, here code use copy slide master ppt template report ppt.

there extraneous code in there provide status updates on form use drive process, debugging flag can toggle on/off @ run time - these can both removed.

this serve starting point finding proper solution situation, , not complete answer question asked.

'i've chosen declare these globally, though it's not best way: dim pptobj powerpoint.application dim pptmaster powerpoint.presentation dim pptclinic powerpoint.presentation   private sub insertppt(byval slidename string, byval statustext string)  dim shp powerpoint.shape dim top single dim left single dim height single dim width single     pptmaster.slides(slidename).copy   pptclinic.slides.paste   form_master.processstatus.value = statustext & " insertppt"   pptclinic.slides(pptclinic.slides.count)     if debugging       .select     end if     .design = pptmaster.slides(slidename).design              'this ensures right formatting - seems necessary 1 time, we'll on     .colorscheme = pptmaster.slides(slidename).colorscheme     .followmasterbackground = pptmaster.slides(slidename).followmasterbackground     each shp in .shapes                                                 'loop through shapes on slide       if debugging '          .select         shp.select       end if       form_master.processstatus.value = statustext & " insertppt-" & shp.name       if shp.type = msolinkedoleobject                                 'when find linked 1         relinkshape shp, tempvars!newxlname         'need store off top, left, width, height         top = shp.top         left = shp.left         height = shp.height         width = shp.width         shp.linkformat.update                                               'and force link refresh         mysleep 2, "s"                                                      'hopefully, 2 second pause allow update before moving on.         'then reset them here - seem change shape when update them         shp.lockaspectratio = msofalse         shp.top = top         shp.left = left         shp.width = width         shp.height = height       elseif shp.name = "slidename" , not debugging                  'if it's "slidename" tag         shp.delete                                                          'delete (unless we're debugging)       end if     next   end    form_master.processstatus.value = statustext  end sub  private sub relinkshape(byref shp powerpoint.shape, byval newdestination string)    dim link() string   dim link2() string    if shp.type = msolinkedoleobject                                 'when find linked 1     link = split(shp.linkformat.sourcefullname, "!")                    'update link point new clinic spreadsheet instead of master     if instr(1, link(2), "]") > 0       link2 = split(link(2), "]")       link(2) = "[" & tempvars!clinicname & ".xlsx]" & link2(1)     end if      shp.linkformat.sourcefullname = newdestination & "!" & link(1) & "!" & link(2)   end if  end sub  public sub mysleep(byref unit double, byref uom string)  dim pause date    pause = dateadd(uom, unit, now())   while < pause     doevents   wend  end sub 

Comments

Popular posts from this blog

javascript - Bootstrap Popover: iOS Safari strange behaviour -

Magento/PHP - Get phones on all members in a customer group -

session - Logging Out Using PHP -