Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
рисуем картинку по условию
 
#1
27.08.2008 12:23:28
Есть колонка со значением угла в градусах, надо нарисовать в соседней колонке стрелку повернутую на этот градус. Бьюсь уже неделю, пока тока дошол до того что нарисовал картинки со стрелками и пытаюсь их вставлять в зависимости от значения (если значение градуса от а до б то ставлю картинку 1).    
вставку значения делаю через поиск.    
 
Cells.Find(What:="1_", After:=ActiveCell, LookIn:=xlValues, LookAt:= _xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate  
   ActiveCell.Select  
   Selection.ClearContents  
   ActiveSheet.Pictures.Insert("D:\Мои документы\Мои рисунки\наклоны\1.jpg").Select    
 
подскажите как сделать?
 
 
 
#2
27.08.2008 12:34:40
отвлеченно...  
есть такой шрифт, неизвестно для чего придуманный - Wingdings 3  
в нем есть стрелочки... допустим, символ 210  
еще есть формат ячейки/выравнивание. там текст можно развернуть на нужный угол...  
это не поможет шевелить стрелочки?
 
 
 
#3
27.08.2008 12:39:50
Sub Макрос1()  
   ActiveSheet.Shapes.AddShape(msoShapeRightArrow, 187.5, 114#, 97.5, 36#).Select  
   Selection.ShapeRange.IncrementRotation 90  
End Sub  
 
Если вид стрелки и картинка несущественны, а вообще к картинке IcrementRotation тоже можно применить
 
 
 
#4
27.08.2008 12:40:26
А нарисовать стрелку и записать макрорекордером изменение ее угла?  
У меня так получилось (после убирания лишнего кода):  
   Selection.ShapeRange.Item("Line 2").Width = 152.25  
   Selection.ShapeRange.Item("Line 2").Height = 67.5  
А значения Width и Height вычислять от угла...
 
 
 
#5
27.08.2008 12:43:09
А проще, включи запись макроса, вставь картинку и покрути её, а потом посмотри что макрос записал. этого должно хваить для разработки своего кода. Совет: чаще пользоваться записью.
 
 
 
#6
27.08.2008 13:10:49
СПАСИБО {quote}{login=Николай}{date=27.08.2008 12:39}{thema=стрелки}{post} IcrementRotation {/post}{/quote}  
то что нужно!!!  
 
Тода еще вопрос можно ли в EXCElе вставлять картинки по координатам? Или хотяб жестко привязывать к нужным ячейкам?
 
 
 
#7
27.08.2008 13:21:51
Range("G13").Select  
ActiveSheet.Pictures.Insert("D:\Ìîè äîêóìåíòû\Ìîè ðèñóíêè\1_06.gif").Select  
вставит картинку в выбранную ячейку
 
 
 
#8
27.08.2008 13:23:07
Range("G13").Select  
ActiveSheet.Pictures.Insert("D:\path\picture.gif").Select  
 
...так понятнее
 
 
 
#9
27.08.2008 16:33:43
Со стрелками разобрался, теперь возникла проблемма с копированием их на другой лист, дело в том что у каждого рисунка имеется свой номер, и когда я макросом копирую рисунок то вызодит ошибка "обьект не найден" т.к. в макросе авторекордером записался номер рисунка на момент записи. Как это обойти?  
Макрос  
 
ActiveCell.Offset(0, 19).Range("A1").Select  
   Application.Run "333.xls!Макрос5"  
   ActiveCell.Offset(-1, 1).Range("A1").Select  
   ActiveSheet.Shapes("Picture 935").Select  
   Selection.Copy  
   Sheets("схема").Select  
   ActiveSheet.Shapes.AddShape(msoShapeRectangle, 93.75, 98.25, 41.25, 38.25). _  
       Select  
   ActiveCell.Offset(-2, -2).Range("A1").Select  
   ActiveSheet.Paste
 
 
 
#10
28.08.2008 08:14:54
Picture 935  
присвой какой-нибудь строковой переменной и массиву коллекцию имён файлов и вызывай в цикле
 
 
 
#11
28.08.2008 08:18:00
видимо каждый раз импортировать файл. но лучше и быстрее рисовать автофигурами.
 
 
 
#12
28.08.2008 08:36:12
Sub copy_Image()  
   Dim shPct As Shape, n As Integer  
   n = 1  
   sheet("Page1").select  
   For Each shPct In ActiveSheet.Shapes  
   shPct.Copy  
   Sheets("Page2").Select  
   ActiveSheet.Range("B" & n).Select  
   ActiveSheet.Paste  
   n = n + 1  
   Next  
End Sub  
макрос копирует с одного листа все картинки на другой в один столбец. Если убрать Select, а явно указывать имена листов, то работать будет ещё быстрее.
 
 
 
#13
28.08.2008 08:58:19
Sub copy_img()  
   Dim shPct As Shape, n As Integer  
   n = 1  
   For Each shPct In ActiveSheet.Shapes  
   Sheets("Page1").Shapes(shPct.Name).Copy  
   Sheets("Page2").Paste  
   n = (n + 1) * 5  
   Next  
End Sub
 
 
 
Страницы: 1
Читают тему
Loading...