Bom dia pessoal, tudo bem?
Me chamo Kaio e trabalho em uma instituição de aprendizagem. Neste local, fiquei com um job de tentar desenvolver um modelo de documentação pedagógico. O formato visual é de muita importância, pois o que pensamos retrata a ideia de temporalidade.
Por isso, preciso, de alguma forma, criar uma macro que insira ao mesmo tempo linhas e colunas , criando então um quadrado, para que assim os lados do quadrado possam ser utilizados para o preenchimento de informações. O número de informações irá variar, e por isso, preciso que o usuário acrescente quantos quadrados quiser, ou seja, cada quadrado preciso gradualmente ser menor que o outro, como na imagem.
Vocês poderiam me ajudar? 
Forte abraço!
Eu nao entendi direito mas tenta isso
Sub Inserir()
Selection.EntireRow.Insert
Selection.EntireColumn.Insert
End Sub
Marcelo Prudencio
"Começar já é a metade do caminho."
Autor Desconhecido
Simplifica que simples fica.
Nicole Tomazella.
"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.
Então, esse código alargaria o retângulo já existente. Eu precisaria inserir um retângulo dentro do já existente, porém, com um tamanho menor. Essa macro precisaria ser utilizada de maneira livre para que quantos retângulos pudessem ser criados conforme a necessidade, entende? Obrigado pela ajuda!!
Complicou....
Marcelo Prudencio
"Começar já é a metade do caminho."
Autor Desconhecido
Simplifica que simples fica.
Nicole Tomazella.
"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.
Eu tbm não entendi muito bem, mas veja se é isso. Considerei que o quadrado ou retângulo é formado através de bordas e que a célula ativa vai estar dentro do quadrado no momento de inserir outros quadrados menores.
Abrçs!
Sub Inserir_QuadRet() On Error Resume Next 'altura do quadrado ou retângulo For a = 0 To 100 If ActiveCell.Offset(-a, 0).Borders(xlEdgeTop).LineStyle = xlContinuous Then a = ActiveCell.Offset(-a, 0).Row Exit For End If Next a For b = 0 To 100 If ActiveCell.Offset(b, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous Then b = ActiveCell.Offset(b, 0).Row Exit For End If Next b 'cumprimento do quadrado ou retângulo For r = 0 To 100 If ActiveCell.Offset(0, r).Borders(xlEdgeRight).LineStyle = xlContinuous Then r = ActiveCell.Offset(0, r).Column Exit For End If Next r For l = 1 To 100 If ActiveCell.Offset(0, -l).Borders(xlEdgeRight).LineStyle = xlContinuous Then l = ActiveCell.Offset(0, -l + 1).Column Exit For End If Next l Range(Cells(a + 1, l + 1), Cells(b - 1, r - 1)).Borders(xlEdgeTop).LineStyle = xlContinuous Range(Cells(a + 1, l + 1), Cells(b - 1, r - 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous Range(Cells(a + 1, l + 1), Cells(b - 1, r - 1)).Borders(xlEdgeRight).LineStyle = xlContinuous Range(Cells(a + 1, l + 1), Cells(b - 1, r - 1)).Borders(xlEdgeLeft).LineStyle = xlContinuous End Sub