• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

denniserra

[Resolvido] Como duplicar linha com campo de texto?

14 mensagens neste tópico

Olá,

Vê lá se é mais ou menos isto:

Copiar o estado individual

    Application.ScreenUpdating = False

    Rows("24:31").Select
    Selection.Copy
    Rows("32:32").Select
    Selection.Insert Shift:=xlDown
    
    [a23].Select
    Selection.Clear
    
    Application.ScreenUpdating = True

Inserir Item

    Application.ScreenUpdating = False

    Rows("37:37").Select
    Selection.Insert Shift:=xlDown
    
    [b37].Select
    Selection.Clear
    
    Application.ScreenUpdating = True

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá,

Funcionou mas ainda não copia a caixa de texto que eu coloquei

vba.jpg

A caixa de texto eu inseri é com Controlo ActiveX, mas de resto está a funcionar, só falta mesmo duplicar a caixa, Tem como???

Abraço!!! :wallbash:

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Ok, depois de copiares o estado fazes isto (+/-):

Dim sh As Shape

Set sh = ActiveSheet.Shapes("TextBox1")
sh.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -10
Selection.ShapeRange.IncrementTop 30

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá!!!

Primeiramente obrigado pela ajuda....

Mas agora apareceram mais 2 problemas:

vba1y.jpg

1º - Os itens copia, mas sem copiar a formatação a linha acima (imagem).

2º - Se eu primeiro inserir o "Estado", depois não consigo inserir os itens (por causa do número das linhas)!

O código:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

    Rows("24:31").Select
    Selection.Copy
    Rows("34:34").Select
    Selection.Insert Shift:=x2Down
    
    [a23].Select
    Selection.Clear
    
    Application.ScreenUpdating = True
    
    Dim sh As Shape

Set sh = ActiveSheet.Shapes("TextBox1")
sh.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -10
Selection.ShapeRange.IncrementTop 140
End Sub

-------------------------------------------------------------------------
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False

    Rows("37:37").Select
    Selection.Insert Shift:=xlDown
    
    [b37].Select
    Selection.Clear
    
    Application.ScreenUpdating = True
    
    Dim sh As Shape

Set sh = ActiveSheet.Shapes("TextBox2")
sh.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop 11

Dim sh1 As Shape

Set sh1 = ActiveSheet.Shapes("TextBox3")
sh1.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop 11

Dim sh2 As Shape

Set sh2 = ActiveSheet.Shapes("TextBox4")
sh2.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop 11

Dim sh3 As Shape

Set sh3 = ActiveSheet.Shapes("TextBox5")
sh3.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop 11

End Sub

Desculpe por tão leigo nisso!!!! :thumbdown:

Abraço!!!

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

http://www.4shared.com/file/88918845/743ee703/Exemplo.html

Esse é o ficheiro que fiz como exemplo, o o "original" está no serviço e estou sem acesso!!!

Então é assim:

1º - Se eu carregar em "inserir estado", ele insere sem problema.

2º - mas depois, se eu "inserir item", (e já estiver inserido "estado") é que dá o problema.

3º - Se eu não inserir "estado", o inserir "iten" funciona, mas as linhas da grade não são copiadas.

Bom, o ficheiro está ai qualquer coisa pode entrar em contacto denniserra@gmail.com

Obrigado mais uma vez!!! :P

Abraço!!!

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Desculpa mas não tenho a versão 2007. Podes fazer um save as para a versão 2003 ?

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Ok, já entendi.

Sabes que para este tipo de abordagem, utilizam-se userforms e não a própria worksheet, mas pode-se sempre encontrar uma solução.

Neste caso o problema deve-se à linha que tu copias não ficar na mesma posição(row) após inserires um estado. Assim deves ver onde a textbox se encontra e depois utilizares essa posição para copiares os dados.

Podes ver a posição desta forma:

Dim rg As Range
Set rg = ActiveSheet.Shapes("TextBox2").TopLeftCell
MsgBox rg.Row

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá!!!

Finalmente concluído!!! :cheesygrin:

O código ficou assim:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

    Rows("22:29").Select
    Selection.Copy
    Rows("31:31").Select
    Selection.Insert Shift:=x2Down
    
    [a23].Select
    Selection.Clear
    
    Application.ScreenUpdating = True
    
    Dim sh As Shape

Set sh = ActiveSheet.Shapes("TextBox1")
sh.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop 131
End Sub

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim rg As Range
Set rg = ActiveSheet.Shapes("TextBox3").TopLeftCell
'MsgBox rg.Row

    'Rows("35:35").Select
    Rows(rg.Row).Select
    
    Selection.Insert Shift:=xlDown
    
    '[b35].Select
    rg.Select
    Selection.Clear
    
    Application.ScreenUpdating = True
    
    Dim sh As Shape

Set sh = ActiveSheet.Shapes("TextBox2")
sh.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop -36

Dim sh1 As Shape

Set sh1 = ActiveSheet.Shapes("TextBox3")
sh1.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop -36

Dim sh2 As Shape

Set sh2 = ActiveSheet.Shapes("TextBox4")
sh2.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop -36

Dim sh3 As Shape

Set sh3 = ActiveSheet.Shapes("TextBox5")
sh3.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop -36

End Sub

Muito Obrigrado mais uma vez,

Abraço!!!  O0

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Como eu coloco RESOLVIDO???

Abraço!!!

Podes editar o teu primeiro tópico e alterar o titulo.

Mas já está :)

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá!!!!

Tenho mais um problema no mesmo ficheiro, tive que colocar mais um botão.

Tenho esse codigo:

Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Dim Pos1 As Integer
Dim Pos2 As Integer
Dim Pos3 As Integer
Dim rg1 As Range
Dim rg2 As Range

Set rg1 = ActiveSheet.Shapes("Label1").TopLeftCell
Set rg2 = ActiveSheet.Shapes("CommandButton3").TopLeftCell
Set rg3 = ActiveSheet.Shapes("Label2").TopLeftCell
Pos1 = rg1.Row
Pos2 = rg2.Row
Pos3 = rg3.Row

    Rows(Pos1 & ":" & Pos2).Select
    'Rows("38:46").Select
    Selection.Copy
    'Rows("48:48").Select
    Rows(Pos3 & ":" & Pos3).Select
    Selection.Insert Shift:=x1Down
    
    rg1.Select
    '[a & Pos1].Select
    Selection.Clear
    Application.ScreenUpdating = True
    
    
Dim sh As Shape
Set sh = ActiveSheet.Shapes("TextBox6")
sh.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop 166


Dim sh1 As Shape
Set sh1 = ActiveSheet.Shapes("TextBox7")
sh1.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop 166


Dim sh2 As Shape
Set sh2 = ActiveSheet.Shapes("TextBox14")
sh2.Select
Selection.Copy
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop 166

Dim sh3 As Shape
Set sh3 = ActiveSheet.Shapes("Label2")
sh3.Select
Selection.Cut
ActiveSheet.Paste

' Defines a posição onde vai ficar
Selection.ShapeRange.IncrementLeft -12
Selection.ShapeRange.IncrementTop 178

Só que no sh3, mando ele fazer um cut e paste, mas ele faz cut da Label2, e depois o paste faz como Label3.  :wallbash:

Tem como fazer um "rename" da Label3 para Label2??? Ou o paste ser feito como Label2???

Abraço!!!

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora