simplificar proceso

hola, fredy !

si las imagenes las puedes obtener con un bucle por la celdas... -> cells(x,y)
lo "ideal" seria que modifiques la "secuencia numerada" de tus controles al mismo orden
y... asumiendo que xy100 es el nombre de un formulario y sus controles de imagen son las XYnn -?-
podrias usar el mismo bucle con algo +/- asi:

with xy100
for n = 1 to ??????
.controls("xy" & n).picture = loadpicture(??? cells(x,y))
next
end with

de lo contrario, necesitaras armar variables de tipo array(... para la secuencia de tus controles -?-

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

__ OP __

estas instrucciones como las puedo simplificar?
xy1000.XY17.Picture = LoadPicture(RUTAPLA & "A.WMF")
xy1000.XY18.Picture = LoadPicture(RUTAPLA & "B.WMF")
xy1000.XY19.Picture = LoadPicture(RUTAPLA & "C.WMF")
xy1000.XY20.Picture = LoadPicture(RUTAPLA & "D.WMF")
xy1000.XY13.Picture = LoadPicture(RUTAPLA & "E.WMF")
xy1000.XY14.Picture = LoadPicture(RUTAPLA & "F.WMF")
xy1000.XY15.Picture = LoadPicture(RUTAPLA & "G.WMF")
xy1000.XY16.Picture = LoadPicture(RUTAPLA & "H.WMF")
xy1000.XY9.Picture = LoadPicture(RUTAPLA & "I.WMF")
xy1000.XY10.Picture = LoadPicture(RUTAPLA & "J.WMF")
xy1000.XY11.Picture = LoadPicture(RUTAPLA & "K.WMF")
xy1000.XY12.Picture = LoadPicture(RUTAPLA & "L.WMF")
xy1000.XY5.Picture = LoadPicture(RUTAPLA & "M.WMF")
xy1000.XY6.Picture = LoadPicture(RUTAPLA & "N.WMF")
xy1000.XY7.Picture = LoadPicture(RUTAPLA & "O.WMF")
xy1000.XY8.Picture = LoadPicture(RUTAPLA & "P.WMF")
xy1000.XY1.Picture = LoadPicture(RUTAPLA & "Q.WMF")
xy1000.XY2.Picture = LoadPicture(RUTAPLA & "R.WMF")
xy1000.XY3.Picture = LoadPicture(RUTAPLA & "S.WMF")
xy1000.XY4.Picture = LoadPicture(RUTAPLA & "T.WMF")
el nombre de la imagen esta en ua tabla que con (cells(x,y)) puedo traerlas
pero como hag variar (xy1000.XY17.Picture =) se puede simplificar??

hola, fredy !

si las imagenes las puedes obtener con un bucle por la celdas... -> cells(x,y)
lo "ideal" seria que modifiques la "secuencia numerada" de tus controles al mismo orden
y... asumiendo que xy100 es el nombre de un formulario y sus controles de imagen son las XYnn -?-
podrias usar el mismo bucle con algo +/- asi:

with xy100
for n = 1 to ??????
.controls("xy" & n).picture = loadpicture(??? cells(x,y))
next
end with

de lo contrario, necesitaras armar variables de tipo array(... para la secuencia de tus controles -?-

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

__ OP __

estas instrucciones como las puedo simplificar?
xy1000.XY17.Picture = LoadPicture(RUTAPLA & "A.WMF")
xy1000.XY18.Picture = LoadPicture(RUTAPLA & "B.WMF")
xy1000.XY19.Picture = LoadPicture(RUTAPLA & "C.WMF")
xy1000.XY20.Picture = LoadPicture(RUTAPLA & "D.WMF")
xy1000.XY13.Picture = LoadPicture(RUTAPLA & "E.WMF")
xy1000.XY14.Picture = LoadPicture(RUTAPLA & "F.WMF")
xy1000.XY15.Picture = LoadPicture(RUTAPLA & "G.WMF")
xy1000.XY16.Picture = LoadPicture(RUTAPLA & "H.WMF")
xy1000.XY9.Picture = LoadPicture(RUTAPLA & "I.WMF")
xy1000.XY10.Picture = LoadPicture(RUTAPLA & "J.WMF")
xy1000.XY11.Picture = LoadPicture(RUTAPLA & "K.WMF")
xy1000.XY12.Picture = LoadPicture(RUTAPLA & "L.WMF")
xy1000.XY5.Picture = LoadPicture(RUTAPLA & "M.WMF")
xy1000.XY6.Picture = LoadPicture(RUTAPLA & "N.WMF")
xy1000.XY7.Picture = LoadPicture(RUTAPLA & "O.WMF")
xy1000.XY8.Picture = LoadPicture(RUTAPLA & "P.WMF")
xy1000.XY1.Picture = LoadPicture(RUTAPLA & "Q.WMF")
xy1000.XY2.Picture = LoadPicture(RUTAPLA & "R.WMF")
xy1000.XY3.Picture = LoadPicture(RUTAPLA & "S.WMF")
xy1000.XY4.Picture = LoadPicture(RUTAPLA & "T.WMF")
el nombre de la imagen esta en ua tabla que con (cells(x,y)) puedo traerlas
pero como hag variar (xy1000.XY17.Picture =) se puede simplificar??

hola Hector Miguel
probe la macro y sale un error ( subindice fuera del intervalo).. y no
subraya nada en amarillo es decir ... #no se donde puede estar el error",
active microsoft visual basic for applications extensibility 5.3 y mi excel
es 2003 sp3..

muchas gracias

Fredy

"Héctor Miguel" wrote:

hola, fredy !

> probando el basico... si funciona
> pero no entiendo porque en el primer codigo no funciona...
> pd: esta activado el " confiar en el acceso a proyectos de visual basic"

del codigo (primero) que dices no estar funcionando... esta es la prueba que me ha funcionado:
comenta cual es la version de excel y si tienes habilitada la referencia a la libreria:
-> microsoft visual basic for applications extensibility (y que numero de version)

saludos,
hector.

Sub pruebahm()
rutapla = ActiveWorkbook.Path & "\"
Sheets("brand").Select
y = 100
x = 100
For Image = 1 To 1
alto = 100
ancho = alto
With ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.Image.1", _
DisplayAsIcon:=False, _
Left:=x, Top:=y, Width:=ancho, Height:=alto)
.Name = Cells(Image, 3)
.Object.Picture = LoadPicture(rutapla & Cells(Image, 3) & ".wmf")
.Object.PictureSizeMode = 1
End With
' add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, _
"private sub " & Cells(Image, 3).Text & "_click()" & vbCr & _
" call tester" & vbCr & "end sub"
End With
Next
End Sub

Sub Tester()
MsgBox "You have click on the test button"
End Sub

hola Hector iguel..
la macro la ejecute y sale un error ( subindice fuera del intervalo) y no
subraya nada en amarillo es decir no se donde puede estar el error... active
la referencia a la libreria: microsoft visual basic for applications
extensibility 5.3 ; la version de mi excel es la 2003 SP3.
:)
muchas gracias

Fredy

"Héctor Miguel" wrote:

hola, fredy !

> probando el basico... si funciona
> pero no entiendo porque en el primer codigo no funciona...
> pd: esta activado el " confiar en el acceso a proyectos de visual basic"

del codigo (primero) que dices no estar funcionando... esta es la prueba que me ha funcionado:
comenta cual es la version de excel y si tienes habilitada la referencia a la libreria:
-> microsoft visual basic for applications extensibility (y que numero de version)

saludos,
hector.

Sub pruebahm()
rutapla = ActiveWorkbook.Path & "\"
Sheets("brand").Select
y = 100
x = 100
For Image = 1 To 1
alto = 100
ancho = alto
With ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.Image.1", _
DisplayAsIcon:=False, _
Left:=x, Top:=y, Width:=ancho, Height:=alto)
.Name = Cells(Image, 3)
.Object.Picture = LoadPicture(rutapla & Cells(Image, 3) & ".wmf")
.Object.PictureSizeMode = 1
End With
' add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, _
"private sub " & Cells(Image, 3).Text & "_click()" & vbCr & _
" call tester" & vbCr & "end sub"
End With
Next
End Sub

Sub Tester()
MsgBox "You have click on the test button"
End Sub

hola, fredy !

la macro la ejecute y sale un error (subindice fuera del intervalo) y no subraya nada en amarillo
es decir no se donde puede estar el error... active la referencia a la libreria:
microsoft visual basic for applications extensibility 5.3; la version de mi excel es la 2003 SP3.

el error por "subindice fuera del intervalo" (generalmente) se debe a referencias a objetos que no existen
(p.e.) sheets("nombre de hoja con algun error tipografico")..

(creo que) la referencia a la libreria (... extensibility x.0) solo se requiere para "eliminar" codigo o modulos

(obviamente) mi entorno (arbol de directorios) es diferente del tuyo, asi que utilice una ruta de "mi" DD
y el siguiente codigo (que es el mismo anterior) si me ha funcionado (tambien xl-2003 SP3)...

saludos,
hector.

- referencias en el proyecto de vba:
Mcrosoft Visual Basic For Applications
Microsoft Excel 11.0 Object Library
Microsoft Forms 2.0 Object Library
OLE Automation

- el codigo utilizado:
Sub pruebahm()
' rutapla = ActiveWorkbook.Path & "\"
' Sheets("brand").Select
rutapla = "c:\archivos de programa\archivos comunes\microsoft shared\clipart\cagcat50\"
Sheets("hoja1").Select
y = 100
x = 100
For Image = 1 To 1
alto = 100
ancho = alto
With ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.Image.1", _
DisplayAsIcon:=False, _
Left:=x, Top:=y, Width:=ancho, Height:=alto)
.Name = Cells(Image, 3)
.Object.Picture = LoadPicture(rutapla & Cells(Image, 3) & ".wmf")
.Object.PictureSizeMode = 1
End With
' add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, _
"private sub " & Cells(Image, 3).Text & "_click()" & vbCr & _
" call tester" & vbCr & "end sub"
End With
Next
End Sub
Sub Tester()
MsgBox "You have click on the test button"
End Sub