Добрый день! Не получается реализавать карту районов города в одном exel файле c картой области. Так же не могу решить проблему с принимаемыми отрицательными значениями. Если у кого будет время и желание просьба помочь.
Добрый день! Не получается реализавать карту районов города в одном exel файле c картой области. Так же не могу решить проблему с принимаемыми отрицательными значениями. Если у кого будет время и желание просьба помочь.panzer123
Да! большое спасибо, а как сделать, что бы 2 разные автофигуры были прикреплены за 1ой строкой(дать одинаковое имя не получается, переключает на уже существующею). То есть на последнем листе 2 Нижегородских района, 2ому не удается привязать "Нижегородский".
Да! большое спасибо, а как сделать, что бы 2 разные автофигуры были прикреплены за 1ой строкой(дать одинаковое имя не получается, переключает на уже существующею). То есть на последнем листе 2 Нижегородских района, 2ому не удается привязать "Нижегородский".panzer123
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] А если удалить из файла пару тысяч лишних картинок, то он и похудеет не слабо.
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
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]если правильно сделал, не работает( Я вроде бы удалял лишние картинки, которые использовал для создания афтофигур.
[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
Сообщение отредактировал Serge_007 - Среда, 25.03.2015, 09:54