powerpoint vba - Add an image to userForm with click event using vba -

-

i created userform make possible create survey. looks @ beginning:

enter image description here

clicking cross next "add answer" can add more rows can seen in other image:

enter image description here

the problem have have add small arrows next checkboxes in new rows. move answers , down if user need change position of them. have add code move them.

the creation of elements need in each row done in following way:

private sub addanswer_click() image5.top = image5.top + 21 checkbox1.top = checkbox1.top + 21 checkbox2.top = checkbox2.top + 21 image7.height = image7.height + 21 image3.top = image3.top + 21 label1.top = label1.top + 21 label4.top = label4.top + 21 image2.top = image2.top + 21 tablet.top = tablet.top + 21 chart.top = chart.top + 21 label8.top = label8.top + 21 label9.top = label9.top + 21 labelorizontal.top = labelorizontal.top + 21 labelvertical.top = labelvertical.top + 21 labelnet.top = labelnet.top + 21 labelround.top = labelround.top + 21 labelpoints.top = labelpoints.top + 21 orizontal.top = orizontal.top + 21 vertical.top = vertical.top + 21 net.top = net.top + 21 points.top = points.top + 21 round.top = round.top + 21 excelbox.top = excelbox.top + 21  okbutton.top = okbutton.top + 21 cancelbutton.top = cancelbutton.top + 21 'me.multipage1.height = me.multipage1.height + 21 image1.height = image1.height + 21  'height = 418 + 21 * (valuenum - 1) if valuenum = 2     me         'this create vertical scrollbar         .multipage1.pages(0).scrollbars = fmscrollbarsvertical          'change values of 2 per requirements         '.scrollheight = .insideheight         '.scrollwidth = .insidewidth * 9     end end if me.multipage1.pages(0).scrollheight = me.multipage1.pages(0).insideheight + 21 * (valuenum - 1) valuenum = valuenum + 1 set ccntrl = me.multipage1.pages(0).controls.add("forms.textbox.1", "textbox" & valuenum, true)     ccntrl         .width = 156         .height = 18         .top = 108 + (valuenum - 1) * 21         .left = 48         .tabindex = tabind         .zorder (0)     end set ccntrl1 = me.multipage1.pages(0).controls.add("forms.textbox.1", "anslabbox" & valuenum, true)     ccntrl1         .width = 144         .height = 18         .top = 108 + (valuenum - 1) * 21         .left = 210         .tabindex = tabind + 1         .zorder (0)     end  tabind = tabind + 3 set ccntrl3 = me.multipage1.pages(0).controls.add("forms.checkbox.1", "open" & valuenum, true)     ccntrl3         .left = 24         .width = 11         .height = 18         .backcolor = "&h8000000e"         .top = 108 + (valuenum - 1) * 21         .zorder (0)     end   '''''''here starts important part question!!! set ccntrl3 = me.multipage1.pages(0).controls.add("forms.image.1", "down" & valuenum - 1, true)     ccntrl3         .left = 12         .width = 12         .height = 6         .backcolor = "&h8000000e"         .top = 116 + (valuenum - 2) * 21         .picture = loadpicture(addinpath & "\fixcontent\triangledown.jpg")         .borderstyle = fmborderstylenone         .picturesizemode = fmpicturesizemodestretch         .zorder (0)     end with activepresentation.vbproject.vbcomponents("surveycreation").codemodule     x = .countoflines     .insertlines x + 1, "private sub down" & valuenum - 1 & "_click()"     .insertlines x + 2, "godown " & valuenum - 1     .insertlines x + 3, "end sub" end set ccntrl3 = me.multipage1.pages(0).controls.add("forms.image.1", "up" & valuenum, true)     ccntrl3         .left = 12         .width = 12         .height = 6         .backcolor = "&h8000000e"         .top = 111 + (valuenum - 1) * 21         .picture = loadpicture(addinpath & "\fixcontent\triangleup.jpg")         .borderstyle = fmborderstylenone         .picturesizemode = fmpicturesizemodestretch         .zorder (0)     end with activepresentation.vbproject.vbcomponents("surveycreation").codemodule     x = .countoflines     .insertlines x + 1, "private sub up" & valuenum & "_click()"     .insertlines x + 2, "goup " & valuenum     .insertlines x + 3, "end sub" end set ccntrl3 = me.multipage1.pages(0).controls.add("forms.image.1", "delete" & valuenum, true)     ccntrl3         .left = 480         .width = 12         .height = 12         .backcolor = "&h8000000e"         .top = 110 + (valuenum - 1) * 21         .picture = loadpicture(addinpath & "\fixcontent\cross.jpg")         .borderstyle = fmborderstylenone         .picturesizemode = fmpicturesizemodestretch         .zorder (0)     end with activepresentation.vbproject.vbcomponents("surveycreation").codemodule     x = .countoflines     .insertlines x + 1, "private sub delete" & valuenum & "_click()"     .insertlines x + 2, "deleterow " & valuenum     .insertlines x + 3, "end sub" end if not combovisi     ccntrl2.visible = false end if end sub

so can see create elements , add code (click events) surveycreation (witch userform)

the deleterow, goup , godown methods defined. never entering in click events. first click events (the ones made arrows appears in first image) defined , working not ones define using code created. can make them work?

as follow comments, here's working example of sort of thing trying do:

class answer

option explicit  public key string public answer string public answerlabel string

class answer controls

option explicit  public withevents answer msforms.textbox public withevents answerlabel msforms.textbox private withevents remove msforms.commandbutton private withevents moveup msforms.label private withevents movedown msforms.label  private p_parent object private p_rowkey string private p_answers answers private p_data answer  const padding = 5 const tbwidth = 100   public sub addrow(top double, left double, parent answers, container object, rowkey string)      set p_parent = container     set p_answers = parent     p_rowkey = rowkey      set answer = p_parent.controls.add("forms.textbox.1", "tb1" + rowkey)     set answerlabel = p_parent.controls.add("forms.textbox.1", "tb2" + rowkey)     set remove = p_parent.controls.add("forms.commandbutton.1", "cb" + rowkey)     set moveup = p_parent.controls.add("forms.label.1", "lb1" + rowkey)     set movedown = p_parent.controls.add("forms.label.1", "lb2" + rowkey)      moveup         .left = left         .top = top         .caption = "up"         .width = 35     end      movedown         .left = left + 20 + padding         .top = top         .caption = "down"         .width = 35     end      answer         .left = left + (35 * 2) + (padding * 2)         .top = top         .width = tbwidth     end      answerlabel         .left = left + (50 * 2) + (padding * 2) + padding + tbwidth         .top = top         .width = tbwidth     end      remove         .left = left + (50 * 2) + (padding * 2) + padding + (tbwidth * 2) + padding         .top = top         .height = answerlabel.height         .caption = "x"     end  end sub  private sub answer_change()     p_data.answer = answer.text end sub  private sub answerlabel_change()     p_data.answerlabel = answerlabel.text end sub  private sub class_terminate()      p_parent.controls.remove answer.name     p_parent.controls.remove answerlabel.name     p_parent.controls.remove moveup.name     p_parent.controls.remove movedown.name     p_parent.controls.remove remove.name  end sub  private sub movedown_click()     p_answers.movedown p_data.key end sub  private sub moveup_click()     p_answers.moveup p_data.key end sub  private sub remove_click()     p_answers.remove p_data.key, p_rowkey end sub public property set data(data answer)     set p_data = data     answer.value = data.answer     answerlabel.value = data.answerlabel end property

class answers

option explicit  private answerlist collection private rowlist collection private no_rows long public parent object  public sub moveup(key string)      dim ans answer     dim x long: x = 1      set ans = answerlist(key)      each ans in answerlist         if ans.key = key exit         x = x + 1     next ans      answerlist.remove key      if x = 1 x = 2 'the item may @ top     answerlist.add ans, ans.key, x - 1      rebind  end sub public sub movedown(key string)      dim ans answer     dim x long: x = 1      set ans = answerlist(key)      each ans in answerlist         if ans.key = key exit         x = x + 1     next ans      answerlist.remove key       if x >= answerlist.count         answerlist.add ans, ans.key     else         answerlist.add ans, ans.key, x + 1     end if      rebind end sub public sub movetotop(key string)      dim ans answer     set ans = answerlist(key)      answerlist.remove key     answerlist.add ans, ans.key, 1 'rebind our data our interface     rebind  end sub public sub remove(key string, rowkey string)      dim ans answer     dim x long: x = 1      answerlist.remove key      rebind      rowlist.remove rowlist.count     no_rows = no_rows - 1 end sub public sub add(newanswer answer)     addrow     answerlist.add newanswer, newanswer.key     set rowlist(rowlist.count).data = newanswer end sub private sub addrow()      dim rowcontrols answercontrols     set rowcontrols = new answercontrols      rowcontrols.addrow 20 * no_rows, 1, me, parent, "r" & no_rows     rowlist.add rowcontrols, "r" & no_rows      no_rows = no_rows + 1  end sub private sub class_initialize()     set answerlist = new collection     set rowlist = new collection     no_rows = 1 end sub  private sub rebind()      dim ans answer     dim x long     x = 1     each ans in answerlist         set rowlist(x).data = ans         x = x + 1     next ans  end sub

simple implementation in userform:

option explicit  dim d answers private sub userform_click()     dim new answer     a.key = rnd * 10     d.add end sub private sub userform_initialize()     set d = new answers     set d.parent = me end sub

Comments

Post a Comment

Popular posts from this blog

C# random value from dictionary and tuple -

-
i have following code, , need random item contains string "region_1" dictionary. public static dictionary<int, tuple<string, int, currencytype>> itemarray = new dictionary<int, tuple<string, int, currencytype>>() { { 0xb3e, new tuple<string, int, currencytype>("region_1", 1500, currencytype.fame) } }; public static int generateitemid(string shopid) { var generateditem = itemarray.elementat(new random().next(0, itemarray.count)).key; } how select this? it's not possible efficiently... first create static random @ class level... prevent non-random behaviour if run query on short period of time... (it's seeded discrete clock) static random rnd = new random(); then: var item = itemarray.values .where(t => t.item1 == shopid) .orderby(_ => rnd.next()) .firstordefault()
Read more

cgi - How do I interpret URLs without extension as files rather than missing directories in nginx? -

-
so i'm trying install zoneminder , have run under nginx, has few compiled files need run using fast-cgi. these files lack extension. if file has extension, there no issue , nginx interprets file , return 404 if can't find it. if has no extension, assume it's directory , return 404 when can't find sort of index page. here have now: # security camera domain. server { listen 888; server_name mydomain.com; root /srv/http/zm; # enable php support. include php.conf; location / { index index.html index.htm index.php; } # enable cgi support. location ~ ^/cgi-bin/(.+)$ { alias /srv/cgi-bin/zm/; fastcgi_pass unix:/run/fcgiwrap.sock; fastcgi_param script_filename $document_root/$1; include fastcgi.conf; } } the idea is, under cgi-bin directory goes through fastcgi pipe. any idea on howi can fix this? upon closer inspection, realized zoneminder has 2 cgi sc...
Read more

.htaccess - htaccess convert request to clean url and add slash at the end of the url -

-
ok , searched more 4 days , more 20 posts here in stach or in websites without kind of success first here htaccess file rewriteengine on rewriterule ^([a-za-z0-9_]+)/?$ index.php?page=$1 [nc] rewriterule ^([a-za-z0-9_]+)\/([a-za-z0-9_]+)\/?$ index.php?page=$1&action=$2 [nc] i tried many codes 1 worked me can call request , works me www.example.com/pagename => www.example.com/index.php?page=pagename here questions , please provide me information "in detail" understand code well 1- how convert request automatically www.example.com/index.php?page=pagename www.example.com/pagename 2- if tried add slash @ end shows me page without images or styling mean www.example.com/pagename => works www.example.com/pagename/ => doesn't work that's :) for first part need 301 rule this: rewritecond %{the_request} /index\.php\?page=([^\s&]+) [nc] rewriterule ^ /%1? [r=301,l] for second part use absolute path in css, js, images files r...
Read more