Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping to insert photo
Dear all
I have below code to insert photo automatically to each line, I need your help to add looping to the code to run same code each line till the empty line. Many thanks Abdul kader == her the code == Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Set rng = ActiveCell myPictName = rng With ActiveSheet With .Range("AA1:AA50") If IsEmpty(ActiveCell) Then Exit Sub On Error Resume Next If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp) If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown) Range(TopCell, BottomCell).Select Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) rng.Select myPict.Top = rng.Top myPict.Left = rng.Left myPict.Width = rng.Width myPict.Height = rng.Height myPict.Name = "Pict_" & .Cells(1).Address(0, 0) End With End With End Sub == end of the code == |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping to insert photo
This code loops. Not sure if it is exacttly what you need. You may have tto
modify the code. Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Set rng = ActiveCell myPictName = rng For Each MyCell In ActiveSheet.Range("AA1:AA50") If IsEmpty(MyCell) Then Exit Sub MyCell.Select Set myPict = ActiveSheet.Pictures.Insert(Filename:=myPictName) myPict.Top = MyCell.Top myPict.Left = MyCell.Left myPict.Width = MyCell.Width myPict.Height = MyCell.Height myPict.Name = "Pict_" & MyCell.Address(0, 0) Next MyCell End Sub "Akader" wrote: Dear all I have below code to insert photo automatically to each line, I need your help to add looping to the code to run same code each line till the empty line. Many thanks Abdul kader == her the code == Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Set rng = ActiveCell myPictName = rng With ActiveSheet With .Range("AA1:AA50") If IsEmpty(ActiveCell) Then Exit Sub On Error Resume Next If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp) If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown) Range(TopCell, BottomCell).Select Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) rng.Select myPict.Top = rng.Top myPict.Left = rng.Left myPict.Width = rng.Width myPict.Height = rng.Height myPict.Name = "Pict_" & .Cells(1).Address(0, 0) End With End With End Sub == end of the code == |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping to insert photo
I'm not sure what you're doing, but maybe something like:
Option Explicit Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Dim testStr As String With ActiveSheet For Each rng In .Range("AA1:AA50").Cells If IsEmpty(rng.Value) Then Exit For End If myPictName = rng.Value testStr = "" On Error Resume Next testStr = Dir(myPictName) On Error GoTo 0 If testStr = "" Then MsgBox myPictName & " wasn't found!" Else Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) With rng.Offset(0, -1) 'column Z myPict.Top = .Top myPict.Left = .Left myPict.Width = .Width myPict.Height = .Height myPict.Name = "Pict_" & .Address(0, 0) End With End If Next rng End With End Sub Akader wrote: Dear all I have below code to insert photo automatically to each line, I need your help to add looping to the code to run same code each line till the empty line. Many thanks Abdul kader == her the code == Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Set rng = ActiveCell myPictName = rng With ActiveSheet With .Range("AA1:AA50") If IsEmpty(ActiveCell) Then Exit Sub On Error Resume Next If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp) If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown) Range(TopCell, BottomCell).Select Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) rng.Select myPict.Top = rng.Top myPict.Left = rng.Left myPict.Width = rng.Width myPict.Height = rng.Height myPict.Name = "Pict_" & .Cells(1).Address(0, 0) End With End With End Sub == end of the code == -- Dave Peterson |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping to insert photo
thank you very much Joel & Dave
for you help, the code are not working as I like. Please download my excel file example for what I need, I hope i will be clear to you. http://www.nouran.com/GetPhoto-temp.zip ---- open the attacfhed file, to run the code / just click on any colume from B4 to B7 then click on (Get photo) , the result will show in the same colume , I need to run the code on all coulme with photo path all together after I click on Get photo. ---- Regards Abdul Kader "Dave Peterson" wrote: I'm not sure what you're doing, but maybe something like: Option Explicit Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Dim testStr As String With ActiveSheet For Each rng In .Range("AA1:AA50").Cells If IsEmpty(rng.Value) Then Exit For End If myPictName = rng.Value testStr = "" On Error Resume Next testStr = Dir(myPictName) On Error GoTo 0 If testStr = "" Then MsgBox myPictName & " wasn't found!" Else Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) With rng.Offset(0, -1) 'column Z myPict.Top = .Top myPict.Left = .Left myPict.Width = .Width myPict.Height = .Height myPict.Name = "Pict_" & .Address(0, 0) End With End If Next rng End With End Sub Akader wrote: Dear all I have below code to insert photo automatically to each line, I need your help to add looping to the code to run same code each line till the empty line. Many thanks Abdul kader == her the code == Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Set rng = ActiveCell myPictName = rng With ActiveSheet With .Range("AA1:AA50") If IsEmpty(ActiveCell) Then Exit Sub On Error Resume Next If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp) If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown) Range(TopCell, BottomCell).Select Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) rng.Select myPict.Top = rng.Top myPict.Left = rng.Left myPict.Width = rng.Width myPict.Height = rng.Height myPict.Name = "Pict_" & .Cells(1).Address(0, 0) End With End With End Sub == end of the code == -- Dave Peterson |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping to insert photo
I don't open other workbooks.
Maybe Joel will--or someone else will. Or you can post a description in plain text. Akader wrote: thank you very much Joel & Dave for you help, the code are not working as I like. Please download my excel file example for what I need, I hope i will be clear to you. http://www.nouran.com/GetPhoto-temp.zip ---- open the attacfhed file, to run the code / just click on any colume from B4 to B7 then click on (Get photo) , the result will show in the same colume , I need to run the code on all coulme with photo path all together after I click on Get photo. ---- Regards Abdul Kader "Dave Peterson" wrote: I'm not sure what you're doing, but maybe something like: Option Explicit Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Dim testStr As String With ActiveSheet For Each rng In .Range("AA1:AA50").Cells If IsEmpty(rng.Value) Then Exit For End If myPictName = rng.Value testStr = "" On Error Resume Next testStr = Dir(myPictName) On Error GoTo 0 If testStr = "" Then MsgBox myPictName & " wasn't found!" Else Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) With rng.Offset(0, -1) 'column Z myPict.Top = .Top myPict.Left = .Left myPict.Width = .Width myPict.Height = .Height myPict.Name = "Pict_" & .Address(0, 0) End With End If Next rng End With End Sub Akader wrote: Dear all I have below code to insert photo automatically to each line, I need your help to add looping to the code to run same code each line till the empty line. Many thanks Abdul kader == her the code == Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Set rng = ActiveCell myPictName = rng With ActiveSheet With .Range("AA1:AA50") If IsEmpty(ActiveCell) Then Exit Sub On Error Resume Next If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp) If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown) Range(TopCell, BottomCell).Select Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) rng.Select myPict.Top = rng.Top myPict.Left = rng.Left myPict.Width = rng.Width myPict.Height = rng.Height myPict.Name = "Pict_" & .Cells(1).Address(0, 0) End With End With End Sub == end of the code == -- Dave Peterson -- Dave Peterson |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping to insert photo
thank Dave
why i need you to open my file, just to see the real example. because maybe i not able to description my request very well. once again thanks "Dave Peterson" wrote: I don't open other workbooks. Maybe Joel will--or someone else will. Or you can post a description in plain text. Akader wrote: thank you very much Joel & Dave for you help, the code are not working as I like. Please download my excel file example for what I need, I hope i will be clear to you. http://www.nouran.com/GetPhoto-temp.zip ---- open the attacfhed file, to run the code / just click on any colume from B4 to B7 then click on (Get photo) , the result will show in the same colume , I need to run the code on all coulme with photo path all together after I click on Get photo. ---- Regards Abdul Kader "Dave Peterson" wrote: I'm not sure what you're doing, but maybe something like: Option Explicit Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Dim testStr As String With ActiveSheet For Each rng In .Range("AA1:AA50").Cells If IsEmpty(rng.Value) Then Exit For End If myPictName = rng.Value testStr = "" On Error Resume Next testStr = Dir(myPictName) On Error GoTo 0 If testStr = "" Then MsgBox myPictName & " wasn't found!" Else Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) With rng.Offset(0, -1) 'column Z myPict.Top = .Top myPict.Left = .Left myPict.Width = .Width myPict.Height = .Height myPict.Name = "Pict_" & .Address(0, 0) End With End If Next rng End With End Sub Akader wrote: Dear all I have below code to insert photo automatically to each line, I need your help to add looping to the code to run same code each line till the empty line. Many thanks Abdul kader == her the code == Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Set rng = ActiveCell myPictName = rng With ActiveSheet With .Range("AA1:AA50") If IsEmpty(ActiveCell) Then Exit Sub On Error Resume Next If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp) If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown) Range(TopCell, BottomCell).Select Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) rng.Select myPict.Top = rng.Top myPict.Left = rng.Left myPict.Width = rng.Width myPict.Height = rng.Height myPict.Name = "Pict_" & .Cells(1).Address(0, 0) End With End With End Sub == end of the code == -- Dave Peterson -- Dave Peterson |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping to insert photo
Maybe someone else will volunteer.
Good luck. Akader wrote: thank Dave why i need you to open my file, just to see the real example. because maybe i not able to description my request very well. once again thanks "Dave Peterson" wrote: I don't open other workbooks. Maybe Joel will--or someone else will. Or you can post a description in plain text. Akader wrote: thank you very much Joel & Dave for you help, the code are not working as I like. Please download my excel file example for what I need, I hope i will be clear to you. http://www.nouran.com/GetPhoto-temp.zip ---- open the attacfhed file, to run the code / just click on any colume from B4 to B7 then click on (Get photo) , the result will show in the same colume , I need to run the code on all coulme with photo path all together after I click on Get photo. ---- Regards Abdul Kader "Dave Peterson" wrote: I'm not sure what you're doing, but maybe something like: Option Explicit Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Dim testStr As String With ActiveSheet For Each rng In .Range("AA1:AA50").Cells If IsEmpty(rng.Value) Then Exit For End If myPictName = rng.Value testStr = "" On Error Resume Next testStr = Dir(myPictName) On Error GoTo 0 If testStr = "" Then MsgBox myPictName & " wasn't found!" Else Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) With rng.Offset(0, -1) 'column Z myPict.Top = .Top myPict.Left = .Left myPict.Width = .Width myPict.Height = .Height myPict.Name = "Pict_" & .Address(0, 0) End With End If Next rng End With End Sub Akader wrote: Dear all I have below code to insert photo automatically to each line, I need your help to add looping to the code to run same code each line till the empty line. Many thanks Abdul kader == her the code == Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range Set rng = ActiveCell myPictName = rng With ActiveSheet With .Range("AA1:AA50") If IsEmpty(ActiveCell) Then Exit Sub On Error Resume Next If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp) If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown) Range(TopCell, BottomCell).Select Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) rng.Select myPict.Top = rng.Top myPict.Left = rng.Left myPict.Width = rng.Width myPict.Height = rng.Height myPict.Name = "Pict_" & .Cells(1).Address(0, 0) End With End With End Sub == end of the code == -- Dave Peterson -- Dave Peterson -- Dave Peterson |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping to insert photo
any how many thanks dave for your support
"Dave Peterson" wrote: Maybe someone else will volunteer. Good luck. Akader wrote: thank Dave why i need you to open my file, just to see the real example. because maybe i not able to description my request very well. once again thanks "Dave Peterson" wrote: I don't open other workbooks. Maybe Joel will--or someone else will. Or you can post a description in plain text. |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping to insert photo
thank you guys
I find solution to my problem , here is the code just for your info. ==== start === Sub GetPhoto() Dim myPict As Picture Dim myPictName As String Dim rng As Range With ActiveSheet With .Range("AA1:AA50") If IsEmpty(ActiveCell) Then Exit Sub On Error Resume Next If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp) If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown) Range(TopCell, BottomCell).Select For Each cl In Selection.Cells cl.Activate Set rng = ActiveCell myPictName = rng Set myPict = .Parent.Pictures.Insert(Filename:=myPictName) myPict.Top = rng.Top myPict.Left = rng.Left myPict.Width = rng.Width myPict.Height = rng.Height myPict.Name = "Pict_" & .Cells(1).Address(0, 0) Next cl End With End With End Sub ==== end === |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Help- Insert text if photo file not available | Excel Discussion (Misc queries) | |||
Insert Photo - help | Excel Discussion (Misc queries) | |||
how do I insert a photo in a protected .xls spreadsheet | Excel Discussion (Misc queries) | |||
Insert photo into a protected worksheet | Excel Worksheet Functions | |||
Insert Photo into a protected worksheet | Excel Worksheet Functions |