Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/реализация карты города и отрицательных значений - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » реализация карты города и отрицательных значений (Макросы/Sub)
реализация карты города и отрицательных значений
panzer123 Дата: Среда, 12.11.2014, 11:49 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 40% ±

Excel 2003
Добрый день! Не получается реализавать карту районов города в одном exel файле c картой области. Так же не могу решить проблему с принимаемыми отрицательными значениями. Если у кого будет время и желание просьба помочь.
К сообщению приложен файл: MAPS.7z (95.4 Kb)
 
Ответить
СообщениеДобрый день! Не получается реализавать карту районов города в одном exel файле c картой области. Так же не могу решить проблему с принимаемыми отрицательными значениями. Если у кого будет время и желание просьба помочь.
Автор - panzer123
Дата добавления - 12.11.2014 в 11:49
Pelena Дата: Среда, 12.11.2014, 12:54 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19196
Репутация: 4423 ±
Замечаний: ±

Excel 365 & Mac Excel
Здравствуйте.
Так подойдёт? (архив в двух частях)
К сообщению приложен файл: MAPS1.part01.rar (78.1 Kb) · MAPS1.part02.rar (77.2 Kb)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Так подойдёт? (архив в двух частях)
Автор - Pelena
Дата добавления - 12.11.2014 в 12:54
panzer123 Дата: Среда, 12.11.2014, 13:42 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 40% ±

Excel 2003
Да! большое спасибо, а как сделать, что бы 2 разные автофигуры были прикреплены за 1ой строкой(дать одинаковое имя не получается, переключает на уже существующею). То есть на последнем листе 2 Нижегородских района, 2ому не удается привязать "Нижегородский".
 
Ответить
СообщениеДа! большое спасибо, а как сделать, что бы 2 разные автофигуры были прикреплены за 1ой строкой(дать одинаковое имя не получается, переключает на уже существующею). То есть на последнем листе 2 Нижегородских района, 2ому не удается привязать "Нижегородский".
Автор - panzer123
Дата добавления - 12.11.2014 в 13:42
RAN Дата: Среда, 12.11.2014, 14:05 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Цитата panzer123, 12.11.2014 в 13:42, в сообщении № 3
не удается привязать "Нижегородский"

[vba]
Код
            Dim shp As Shape
             For Each shp In .Shapes
                 If shp.Name = strStateName Then
                     shp.Fill.Solid
                     shp.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup + 2, 1).Offset(0, 2).Interior.Color
                 End If
             Next
[/vba]
А если удалить из файла пару тысяч лишних картинок, то он и похудеет не слабо.

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Цитата panzer123, 12.11.2014 в 13:42, в сообщении № 3
не удается привязать "Нижегородский"

[vba]
Код
            Dim shp As Shape
             For Each shp In .Shapes
                 If shp.Name = strStateName Then
                     shp.Fill.Solid
                     shp.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup + 2, 1).Offset(0, 2).Interior.Color
                 End If
             Next
[/vba]
А если удалить из файла пару тысяч лишних картинок, то он и похудеет не слабо.
Автор - RAN
Дата добавления - 12.11.2014 в 14:05
panzer123 Дата: Среда, 12.11.2014, 15:46 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 40% ±

Excel 2003
[vba]
Код
Dim intState As Integer
Dim strStateName As String
Dim intStateValue As Single
Dim intColourLookup As Integer
Dim rngStates As Range
Dim rngColours As Range
Dim shp As Shape

Set rngStates = Range(ThisWorkbook.Names("regions1").RefersTo)
Set rngColours = Range(ThisWorkbook.Names("colors1").RefersTo)

With Worksheets("NNmap")
For intState = 2 To rngStates.Rows.Count
strStateName = rngStates.Cells(intState, 1).Text
intStateValue = rngStates.Cells(intState, 2).Value
intColourLookup = Application.WorksheetFunction.VLookup(intStateValue, Range("colors"), 2)
With .Shapes(strStateName)
.Fill.Solid
.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup + 2, 1).Offset(0, 2).Interior.Color
End With
Next
For Each shp In .Shapes
If shp.Name = strStateName Then
shp.Fill.Solid
shp.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup + 2, 1).Offset(0, 2).Interior.Color
End If
Next
End With
End Sub
[/vba]если правильно сделал, не работает( Я вроде бы удалял лишние картинки, которые использовал для создания афтофигур.


Сообщение отредактировал Serge_007 - Среда, 25.03.2015, 09:54
 
Ответить
Сообщение[vba]
Код
Dim intState As Integer
Dim strStateName As String
Dim intStateValue As Single
Dim intColourLookup As Integer
Dim rngStates As Range
Dim rngColours As Range
Dim shp As Shape

Set rngStates = Range(ThisWorkbook.Names("regions1").RefersTo)
Set rngColours = Range(ThisWorkbook.Names("colors1").RefersTo)

With Worksheets("NNmap")
For intState = 2 To rngStates.Rows.Count
strStateName = rngStates.Cells(intState, 1).Text
intStateValue = rngStates.Cells(intState, 2).Value
intColourLookup = Application.WorksheetFunction.VLookup(intStateValue, Range("colors"), 2)
With .Shapes(strStateName)
.Fill.Solid
.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup + 2, 1).Offset(0, 2).Interior.Color
End With
Next
For Each shp In .Shapes
If shp.Name = strStateName Then
shp.Fill.Solid
shp.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup + 2, 1).Offset(0, 2).Interior.Color
End If
Next
End With
End Sub
[/vba]если правильно сделал, не работает( Я вроде бы удалял лишние картинки, которые использовал для создания афтофигур.
Автор - panzer123
Дата добавления - 12.11.2014 в 15:46
RAN Дата: Среда, 12.11.2014, 20:07 | Сообщение № 6
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
With .Shapes(strStateName)  
.Fill.Solid  
.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup + 2, 1).Offset(0, 2).Interior.Color  
End With  
Next
[/vba]
Это нужно заменить на то, что в №4

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
With .Shapes(strStateName)  
.Fill.Solid  
.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup + 2, 1).Offset(0, 2).Interior.Color  
End With  
Next
[/vba]
Это нужно заменить на то, что в №4
Автор - RAN
Дата добавления - 12.11.2014 в 20:07
Мир MS Excel » Вопросы и решения » Вопросы по VBA » реализация карты города и отрицательных значений (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!