Este fórum está sendo desativado

[fmcblues]

Boa tarde pessoal,

Utilizo o seguinte código para agrupar shapes no Excel (funciona perfeitamente):

Sub Agrupar()
ActiveSheet.Shapes.Range(Array("Forma1", "Forma2", "Forma3", "Forma4", "Forma5", "Forma6")).Select
Selection.ShapeRange.Group.Select
End Sub

Minha dúvida é a seguinte: teria como agrupar os shapes de acordo com as cores que possuem?
Por exemplo: tudo que for vermelho ficaria agrupado... Assim como tudo que fosse verde ficaria agrupado em outro grupo diferente do primeiro.

Agradeço mais uma vez pela ajuda e deixo um muito obrigado ao laennder e ao Reinaldo, por me ajudarem tão rapidamente em outro tópico.

[alexandrevba]

Boa tarde!!


Considerando a cor verde cana dos retângulos veja se ajuda.
Para mais informações veja a fonte:
http://answers.microsoft.com/en-us/offi ... b=5&auth=1

Código: Selecionar todos

Sub AleVBA_1110()
    With ActiveSheet.Shapes
      If Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11 Then
      ActiveSheet.Shapes.Range(Array("Retângulo 1", "Retângulo 2", "Retângulo 3")).Select
            Selection.ShapeRange.Group.Select
      End If
    End With
End Sub

Att

[fmcblues]

Um bom dia a todos!

alexandrevba, não consegui aplicar esse método aqui. Não aconteceu nada.
Preciso disso para aplicar ao mapa depois que ele estiver colorido. Isso tudo para conseguir fazer o esquema da terceira aula sobre mapas interativos aqui do site do Guru do Excel.
Trabalho com regiões muito específicas do meu estado. Assim, não consigo encontrar imagens dessas áreas em nenhum lugar. Vou ter que criar na raça.
Somente depois de obter isso que poderei clicar sobre alguma região do mapa e conseguir fazer com que fiquem ampliadas (que é a finalidade da aula 3).
Além disso, ao invés de definir uma cor como no Fill.ForeColor.SchemeColor = 11, teria como dizer ao código: "Quero a cor da célula A1"?

Meu arranjo é bem grande:

"3100104", "3100203", "3100302", "3100401", "3100500", "3100609", "3100708", "3100807", "3100906", "3101003", "3101102", "3101201", "3101300", "3101409", "3101508", "3101607", "3101631", "3101706", "3101805", "3101904", "3102001", "3102050", "3102100", "3102209", "3102308", "3102407", "3102506", "3102605", "3102704", "3102803", "3102852", "3102902", "3103009", "3103108", "3103207", "3103306", "3103405", "3103504", "3103603", "3103702", "3103751", "3103801", "3103900", "3104007", "3104106", "3104205", "3104304", "3104403", "3104452", "3104502", "3104601", "3104700", "3104809", "3104908", "3105004", "3105103", "3105202", "3105301", "3105400", "3105509", "3105608", "3105707", "3105905", "3106002", "3106101", "3106200", "3106309", "3106408", "3106507", "3106606", "3106655", "3106705", "3106804", "3106903", "3107000", "3107109", "3107208", "3107307", "3107406", "3107505", "3107604", "3107703", "3107802", "3107901", "3108008", "3108107", "3108206", "3108255", "3108305", "3108404", "3108503", "3108552", "3108602", "3108701", "3108800", "3108909", "3109006", "3109105", "3109204", "3109253", "3109303", "3109402", "3109451", "3109501", "3109600", "3109709", "3109808", "3109907", "3110004", "3110103", "3110202", "3110301", "3110400", "3110509", "3110608", "3110707", "3110806", "3110905", "3111002", "3111101", "3111150", "3111200", "3111309", "3111408", "3111507", "3111606", "3111705", "3111804", "3111903", "3112000", "3112059", "3112109", "3112208", "3112307", "3112406", "3112505", "3112604", "3112653", "3112703", "3112802", "3112901", "3113008", "3113107", "3113206", "3113305", "3113404", "3113503", "3113602", "3113701", "3113800", "3113909", "3114006", "3114105", "3114204", "3114303", "3114402", "3114501", "3114550", "3114600", "3114709", "3114808", "3114907", "3115003", "3115102", "3115201", "3115300", "3115359", "3115409", "3115458", "3115474", "3115508", "3115607", "3115706", "3115805", "3115904", "3116001", "3116100", "3116159", "3116209", "3116308", "3116407", "3116506", "3116605", "3116704", "3116803", "3116902", "3117009", "3117108", "3117207", "3117306", "3117405", "3117504", "3117603", "3117702", "3117801", "3117836", "3117876", "3117900", "3118007", "3118106", "3118205", "3118304", "3118403", "3118502", "3118601", "3118700", "3118809", "3118908", "3119005", "3119104", "3119203", "3119302", "3119401", "3119500", "3119609", "3119708", "3119807", "3119906", "3119955", "3120003", "3120102", "3120151", "3120201", "3120300", "3120409", "3120508", "3120607", "3120706", "3120805", "3120839", "3120870", "3120904", "3121001", "3121100", "3121209", "3121258", "3121308", "3121407", "3121506", "3121605", "3121704", "3121803", "3121902", "3122009", "3122108", "3122207", "3122306", "3122355", "3122405", "3122454", "3122470", "3122504", "3122603", "3122702", "3122801", "3122900", "3123007", "3123106", "3123205", "3123304", "3123403", "3123502", "3123528", "3123601", "3123700", "3123809", "3123858", "3123908", "3124005", "3124104", "3124203", "3124302", "3124401", "3124500", "3124609", "3124708", "3124807", "3124906", "3125002", "3125101", "3125200", "3125309", "3125408", "3125507", "3125606", "3125705", "3125804", "3125903", "3125952", "3126000", "3126109", "3126208", "3126307", "3126406", "3126505", "3126604", "3126703", "3126752", "3126802", "3126901", "3126950", "3127008", "3127057", "3127073", "3127107", "3127206", "3127305", "3127339", "3127354", "3127370", "3127388", "3127404", "3127503", "3127602", "3127701", "3127800", "3127909", "3128006", "3128105", "3128204", "3128253", "3128303", "3128402", "3128501", "3128600", "3128709", "3128808", "3128907", "3129004", "3129103", "3129202", "3129301", "3129400", "3129509", "3129608", "3129657", "3129707", "3129806", "3129905", "3130002", "3130051", "3130101", "3130200", "3130309", "3130408", "3130507", "3130556", "3130606", "3130655", "3130705", "3130804", "3130903", "3131000", "3131109", "3131158", "3131208", "3131307", "3131406", "3131505", "3131604", "3131703", "3131802", "3131901", "3132008", "3132107", "3132206", "3132305", "3132404", "3132503", "3132602", "3132701", "3132800", "3132909", "3133006", "3133105", "3133204", "3133303", "3133402", "3133501", "3133600", "3133709", "3133758", "3133808", "3133907", "3134004", "3134103", "3134202", "3134301", "3134400", "3134509", "3134608", "3134707", "3134806", "3134905", "3135001", "3135050", "3135076", "3135100", "3135209", "3135308", "3135357", "3135407", "3135456", "3135506", "3135605", "3135704", "3135803", "3135902", "3136009", "3136108", "3136207", "3136306", "3136405", "3136504", "3136520", "3136553", "3136579", "3136603", "3136652", "3136702", "3136801", "3136900", "3136959", "3137007", "3137106", "3137205", "3137304", "3137403", "3137502", "3137536", "3137601", "3137700", "3137809", "3137908", "3138005", "3138104", "3138203", "3138302", "3138351", "3138401", "3138500", "3138609", "3138625", "3138658", "3138674", "3138682", "3138708", "3138807", "3138906", "3139003", "3139102", "3139201", "3139250", "3139300", "3139409", "3139508", "3139607", "3139706", "3139805", "3139904", "3140001", "3140100", "3140159", "3140209", "3140308", "3140407", "3140506", "3140530", "3140555", "3140605", "3140704", "3140803", "3140852", "3140902", "3141009", "3141108", "3141207", "3141306", "3141405", "3141504", "3141603", "3141702", "3141801", "3141900", "3142007", "3142106", "3142205", "3142254", "3142304", "3142403", "3142502", "3142601", "3142700", "3142809", "3142908", "3143005", "3143104", "3143153", "3143203", "3143302", "3143401", "3143450", "3143500", "3143609", "3143708", "3143807", "3143906", "3144003", "3144102", "3144201", "3144300", "3144359", "3144375", "3144409", "3144508", "3144607", "3144656", "3144672", "3144706", "3144805", "3144904", "3145000", "3145059", "3145109", "3145208", "3145307", "3145356", "3145372", "3145406", "3145455", "3145505", "3145604", "3145703", "3145802", "3145851", "3145877", "3145901", "3146008", "3146107", "3146206", "3146255", "3146305", "3146404", "3146503", "3146552", "3146602", "3146701", "3146750", "3146909", "3147006", "3147105", "3147204", "3147303", "3147402", "3147501", "3147600", "3147709", "3147808", "3147907", "3147956", "3148004", "3148103", "3148202", "3148301", "3148400", "3148509", "3148608", "3148707", "3148756", "3148806", "3148905", "3149002", "3149101", "3149150", "3149200", "3149309", "3149408", "3149507", "3149606", "3149705", "3149804", "3149903", "3149952", "3150000", "3150109", "3150158", "3150208", "3150307", "3150406", "3150505", "3150539", "3150570", "3150604", "3150703", "3150802", "3150901", "3151008", "3151107", "3151206", "3151305", "3151404", "3151503", "3151602", "3151701", "3151800", "3151909", "3152006", "3152105", "3152131", "3152170", "3152204", "3152303", "3152402", "3152501", "3152600", "3152709", "3152808", "3152907", "3153004", "3153103", "3153202", "3153301", "3153400", "3153509", "3153608", "3153707", "3153806", "3153905", "3154002", "3154101", "3154150", "3154200", "3154309", "3154408", "3154457", "3154507", "3154606", "3154705", "3154804", "3154903", "3155009", "3155108", "3155207", "3155306", "3155405", "3155504", "3155603", "3155702", "3155801", "3155900", "3156007", "3156106", "3156205", "3156304", "3156403", "3156452", "3156502", "3156601", "3156700", "3156809", "3156908", "3157005", "3157104", "3157203", "3157252", "3157278", "3157302", "3157336", "3157377", "3157401", "3157500", "3157609", "3157658", "3157708", "3157807", "3157906", "3158003", "3158102", "3158201", "3158300", "3158409", "3158508", "3158607", "3158706", "3158805", "3158904", "3158953", "3159001", "3159100", "3159209", "3159308", "3159357", "3159407", "3159506", "3159605", "3159704", "3159803", "3159902", "3160009", "3160108", "3160207", "3160306", "3160405", "3160454", "3160504", "3160603", "3160702", "3160801", "3160900", "3160959", "3161007", "3161056", "3161106", "3161205", "3161304", "3161403", "3161502", "3161601", "3161650", "3161700", "3161809", "3161908", "3162005", "3162104", "3162203", "3162252", "3162302", "3162401", "3162450", "3162500", "3162559", "3162575", "3162609", "3162658", "3162708", "3162807", "3162906", "3162922", "3162948", "3162955", "3163003", "3163102", "3163201", "3163300", "3163409", "3163508", "3163607", "3163706", "3163805", "3163904", "3164001", "3164100", "3164209", "3164308", "3164407", "3164431", "3164472", "3164506", "3164605", "3164704", "3164803", "3164902", "3165008", "3165107", "3165206", "3165305", "3165404", "3165503", "3165537", "3165552", "3165560", "3165578", "3165602", "3165701", "3165800", "3165909", "3166006", "3166105", "3166204", "3166303", "3166402", "3166501", "3166600", "3166709", "3166808", "3166907", "3166956", "3167004", "3167103", "3167202", "3167301", "3167400", "3167509", "3167608", "3167707", "3167806", "3167905", "3168002", "3168051", "3168101", "3168200", "3168309", "3168408", "3168507", "3168606", "3168705", "3168804", "3168903", "3169000", "3169059", "3169109", "3169208", "3169307", "3169356", "3169406", "3169505", "3169604", "3169703", "3169802", "3169901", "3170008", "3170057", "3170107", "3170206", "3170305", "3170404", "3170438", "3170479", "3170503", "3170529", "3170578", "3170602", "3170651", "3170701", "3170750", "3170800", "3170909", "3171006", "3171030", "3171071", "3171105", "3171154", "3171204", "3171303", "3171402", "3171501", "3171600", "3171709", "3171808", "3171907", "3172004", "3172103", "3172202"

Ufa... É muita doidera, mas uma hora funciona!

Muito obrigado

[Reinaldo]

Sem ver o modelo fica um tanto quanto dificil, mas tente adaptar

Código: Selecionar todos

Sub agrupa()
Dim sH As Variant
Dim mArray() As String, x As Integer
ActiveSheet.Range("A1").Interior.ColorIndex = 10
ReDim Preserve mArray(0)
For Each sH In ActiveSheet.Shapes
    With sH
    .Select
        If Selection.ShapeRange.Fill.ForeColor.SchemeColor = ActiveSheet.Range("A1").Interior.ColorIndex Then
            x = UBound(mArray)
            mArray(x) = sH.Name
        End If
    ReDim Preserve mArray(x + 1)
    End With
Next
 ActiveSheet.Shapes.Range((mArray)).Select
Selection.ShapeRange.Group.Select
End Sub

[fmcblues]

Boa tarde,

Não obtive êxito com as explicações dos colegas.
Irei marcar o tópico como finalizado e continuarei utilizando o código que havia apresentado anteriormente.

Sub Agrupar()
ActiveSheet.Shapes.Range(Array("Forma1", "Forma2", "Forma3", "Forma4", "Forma5", "Forma6")).Select
Selection.ShapeRange.Group.Select
End Sub

Muito obrigado a todos!

Flávio

[alexandrevba]

Boa tarde!!

Visto que até agora (mesmo com minha resposta e a do reinaldo), mesmo assim vc não postou seu arquivo modelo e que nos meus testes e entendimento deram certo, não vejo outra forma de lhe ajudar, caso queira poste um arquivo modelo ou aguarde outro colaborador que possa resolver mesmo a questão.


Att

[fmcblues]

Boa tarde alexandrevba!

Segue um arquivo com toda a explicação e aplicação da macro.
Peço desculpa pela minha grave falha em não enviar o arquivo anteriormente!

Muito obrigado pelo tempo dedicado por todos.

[Reinaldo]

Veja no Anexo, uma possibilidade

[fmcblues]

Boa Reinaldo!

Para o arquivo que você anexou, ficou muito bom. Funcionou direitinho!
Vou tentar adaptar aos meus mapas.
Com isso já irei ganhar muito tempo de serviço.
Vou aguardar mais uns 2 dias para fechar o tópico... Quem sabe mais alguém tenha pensado em algo.

Muito obrigado novamente!

Flávio

[alexandrevba]

Bom dia!!

Desculpa pelo atraso, mas se o do reinaldo, não resolver eu espero que esse código ajuda.

Código: Selecionar todos

Sub AleVBA_1110()
    Dim sH As Variant
    Dim mArray() As String, x As Integer
    Dim counter As Integer
   
    ReDim mArray(0)
A:
    For Each sH In ActiveSheet.Shapes
        With sH
            If .Name Like "Group" & "*" Then
                sH.Ungroup
            Else
                If .Fill.ForeColor = ActiveSheet.Range("S1").Interior.Color Then
                  x = UBound(mArray)
                  mArray(x) = sH.Name
                  ReDim Preserve mArray(x + 1)
                End If
            End If
        End With
    Next

    If x = 0 And counter = 0 Then
      counter = counter + 1
      GoTo A:
    End If
   
    ActiveSheet.Shapes.Range((mArray)).Select
    Selection.ShapeRange.Group.Select
End Sub

Att

[fmcblues]

Boa tarde!

A resposta do Reinaldo já estava me atendia perfeitamente...
Mas essa sua foi ultra-mega-power fantástica.
Era exatamente isso que eu imaginava.

Muito obrigado a todos pelo tempo a paciência gastos na resolução desse problema.

\ o /