Notifications
Clear all

alocar na memoria

9 Posts
3 Usuários
0 Reactions
1,538 Visualizações
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Gostaria que na rotina abaixo eu pudesse associar a Celula C5 de uma planilha a " MV Recreio" sei que pra isso seria atraves de uma Dim né ? Portanto pode me passar o codigo certo pra nao ter que escrever MV Recreio e me basear sempre por C5 ?

'Declaração de ariaveis
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim nome

nome = C5

'Set Ws1 = Sheets("Mv Recreio") 'Referencia a guia Resumo como Ws1

 
Postado : 29/11/2015 8:52 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não sei se entendi direito, mas para deixarmos o Valor de uma Variável em memoria para uso futuro, temos que primeiro torna-la "Publica", então em um Módulo qualquer coloque a instrução:

Public nome

E em sua rotina utilize :

nome = Sheets("Mv Recreio").Range("C5")

Set Ws1 = Sheets(nome)
   
   MsgBox Ws1.Name
   
   'seleciona a aba
   Ws1.Select

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 29/11/2015 9:17 am
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Ola Mauro Coutinho,

É o seguinte. Nesta rotina quero esquecer o MV Recreio. POis "MV Recreio", é o nome que foi dado a uma planilha criada atraves de uma outra macro. Eu criei um sistema em que Tenho uma planilha de Aba chamada Resumo. Esta atraves de uma outra macro ira irá criar varias outras Abas e chamá-las conforme um nome "X" que esta numa celula H10 em "Resumo". Neste exemplo criou-se a Planilha MV Revreio, poderia ser MV Meier, MV Anchieta etc. Entao agora que tenho esta Planilha de Nome Recreio recem criada. Tenho que ter outra Macro com outro Objetivo e todas as vezes que esta nova Macro for Executada, tomará como base a Celula "C5", onde vai estar justamente o nome da aba a qual se referencia. Se esta Macro for executada dentro da aba MV Recreio entao quero que :

'Set Ws1 = Sheets("C5") 'Referencia a guia Resumo como Ws1

Se for executada dentro da Aba MV Meier, entao

'Set Ws1 = Sheets("C5") 'Referencia a guia Resumo como Ws1

Todas as macros criadas terao C5 e em C5 estara o nome da Loja que é o nome da ABA.

Grato amigao.

 
Postado : 29/11/2015 10:10 am
(@suggos)
Posts: 111
Estimable Member
 

É isto que você quer?

Sub nomear()

If Not IsEmpty(Sheets("Resumo").Range("H10")) Then
    ActiveSheet.Name = Sheets("Resumo").Range("H10")
Else
    MsgBox " A célula H10 da aba Resumo está vazia."
End If

End Sub

Não se esqueça de marcar o tópico como resolvido se a resposta for satisfatória.

 
Postado : 29/11/2015 3:59 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Ficou um pouco confuso a explicação, mas pelo que entendi você já tem uma rotina que cria outra com o nome em "H10", então é só adaptar esta rotina para a celula "C5" da planilha criada.
Se ainda não for isto, coloque a rotina que utiliza para criar a planilha.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 29/11/2015 5:41 pm
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

OLa suggos, e quase isso. e Coutinho

Quando eu tiro um pedido o tiro numa aba chamada RESUMO. Quando tenho todas as Inf. envio desta aba mesmo o pedido por uma macro. Mas muitas das vezes nao tenho ainda todas as inf. para envio, mas tenho que deixar esta ABA limpa para o proximo pedido.
Quando eu crio as novas Abas, atraves de uma Macro 'X " que ficarao em Standy By, é porque estou aguardando algumas informacoes antes de fazer o envio do pedido atraves de uma outra Macro, ( enviar pedido). Assim se tiver pedidos a tirar vou pondo estes em Stand By. Porem para nao travar a minha Planilha é que crio estas abas Stand By, assim se eu tiver outros pedidos que ficaram em Standy By, terao outros nomes as abas, se nao , ou seja, tiver todas as informacoes necessarias para envio do pedido, entao ja uso a celula H10 (RESUMO) e entao aciono a macro de envio do Pedido. Mas acontece que cada aba em Stany By sao identicas no seu formato, muda os dados da loja e os produtos comprados e muda o nome da aba, Loja 1, Loja 2, loja 3 etc. O nome que é dado a estas abas estao na celula C5 de cada uma delas, ou seja cada aba se refere a um nome fantasia de uma loja. Entao se o Nome fantasia da aba Loja 1 por exemplo, esta na celula C5, sera a celula C5 que a macro de envio ira se basear, pois esta Macro servira para todos os pedidos em Stand By,

Por isso se eu rodar a rotina abaixo vai rodar perfeita, desde que eu use a :

Set Ws1 = Sheets("Loja 1")

Eu quero que ao inves de escrever Loja 1, possa escrever por exemplo a Celula : C5, Pois C5 = a aba em questao, seja ela MV Meier, MV Recreio, LOja 1, Loja 2 , LOja 3 ....

Lembrando que todas as abas em Stnady by sao iguais mundando apenas os dados de cada loja e seus respectivos pedidos. QUando tenho todas as informacoes de uma desta abas em Standy By, ja posso enviar o pedido , dai a macro envia o pedido por email, pega dados relativos de minha comissao e os salva em outra Aba de nome Lancar Comissoes, sempre pegando uma linha vazia . Depois disto esta aba nao me serve mais dai entao eu a excluo dentro do mesmo comando da Macro que foi acionada.

Se eu nao informar a Macro , atraves de uma Celula qual aba ela deve se basear para ENviar o pedido, salvar as comissoes, entao terei que fazer manualmente dentro do comando e assim esta funcionando correto.

Eis abaixo a Macro que esta perfeita.

Tudo que quero é nao ter que colocar dentro da rotina o nome da Loja e sim onde ela vai pegar , neste caso C5.

Ficou grande desta forma por que usei o Gravar Macro, ja que nao manjo de VBa.

Sub gravar_Envio_Gauer()

'Botao Enviar Planilha que esta em Modelo Frete

'Salva a comissao

'Declaração de ariaveis
    Dim Ws1     As Worksheet
    Dim Ws2     As Worksheet
    Dim nome
    
    'nome = C5 ( AQUI é ONDE eu gostaria que seguisse como referencia para Set WS1 = Sheets("MV Meier")
    
    Dim Dest    As Range


  'Application.ScreenUpdating = 0                                      'Deixa a macro mais rápida (Desliga a tela de atualização)
        
        Set Ws1 = Sheets("Mv Meier")                                      'Referencia a guia Resumo como Ws1
        
        Set Ws2 = Sheets("LANCAR COMISSAO")                             'Referencia a guia LANÇAR COMISSAO como Ws2
        
        Set Dest = Ws2.Range("B3").Range("B52").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)

        Ws1.Range("AA3:AG3").Copy                                        'Copia o intervalo AB2:AG2 da guia Resumo
        Dest.PasteSpecial xlPasteValues                                  'Cola valores na guia Comissão
        Application.CutCopyMode = False                                  'Desativaj o clipboard


' Botao Enviar Pedido

    Sheets("PEDIDO G").Select
    Range("C3:G3").Select
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C2:G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C5:E5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C4:E4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("F5:G5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F4:G4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C7:G7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C6:G6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("A8:B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("A7:B7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("A9:B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("A8:B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C8:G10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C7:D7").Select
    Sheets("PEDIDO G").Select
    Range("C8:D8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C7:D7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C9:D9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C8:D8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("D10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("D9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("E8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("E7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("F8:G8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F7:G7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("E9:G9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("E8:G8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("E10:G10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("E9:G9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("F6:G6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F5:G5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO GAUER").Select
    Range("F51").Select
    Application.CutCopyMode = False
    Sheets("PEDIDO G").Select
    Range("F52").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F51").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("G53:G60").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G52").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
  
   'Rotina proteger tabela
   'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

 'Rotina enviar por Email

 'Define a Planilha que será enviada por Email. Ex: Plan1, Plan2, Pedidos, etc
 sPlanAEnviar = "PEDIDO GAUER"
 
'Cria um novo arquivo Excel
 Set NovoArquivoXLS = Application.Workbooks.Add
 
 'Copia a Planilha para o novo arquivo criado
 ThisWorkbook.Sheets(sPlanAEnviar).Copy Before:=NovoArquivoXLS.Sheets(1)
 
'Salva o Arquivo
 NovoArquivoXLS.SaveAs ThisWorkbook.Path & "" & sPlanAEnviar & ".xLs"
sExcluirAnexoTemporario = NovoArquivoXLS.FullName

'Envia o email deixei OFF por enquanto
'NovoArquivoXLS.SendMail "gauer@gauerdobrasil.com.br", "Frete " & [F4].Value, True

'Fecha o Arquivo Novo
NovoArquivoXLS.Close

'Exclui o arquivo criado apenas para ser enviado
Kill sExcluirAnexoTemporario


   'Rotina Desproteger Tabela
   'ActiveSheet.Unprotect


'DEixa a planilha pronta para o proximo envio

    Range("C2:G2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("C4:E4").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F4:G4").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F5:G5").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C6:G6").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A7:B7").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C7:D7").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E7").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F7:G7").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E8:G8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C8:D8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A8:B8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A9:B9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E9:G9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F51").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G52").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G53").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G54").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G55").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G56").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G57").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G58").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G59").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A52").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A53").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A54").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C52").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C53").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C54").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F4:G4").Select
   
   'Aqui eu quero que novamente cache de Memoria C5 entre em acao, para apagar a planilha, veja que coloquei abaixo  'For Each wsPlan In Worksheets(Array("MV Meier"))
   
 ' Excluir_Planilha Macro

  'Dim wsPlan As Worksheet
    ' On Error Resume Next
    'For Each wsPlan In Worksheets(Array("MV Meier"))
    ' Application.DisplayAlerts = False
    '  wsPlan.Delete
     ' Application.DisplayAlerts = True
    'Next wsPlan
      
End Sub
 
Postado : 29/11/2015 5:42 pm
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Note que se eu executar esta macro acima, sendo a sua aba de nome MV Recreio e a C5 dela MV Recreio, dara um erro " subscrito fora do intervalo ", isto porque especifiquei manualmente

Set Ws1 = Sheets("Mv Meier")

como sendo MV Meier, se eu arrumar uma forma de especificar que seja C5 , resolvo meu problema !

Andre

 
Postado : 29/11/2015 5:52 pm
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Consegui, era isso que eu queria, descobri fuçando aqui, quando somos leigos, vamos tentando ate sair.

Agradeço o empenho de todos

'Declaração de ariaveis
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim nome

Dim Dest As Range

'Application.ScreenUpdating = 0 'Deixa a macro mais rápida (Desliga a tela de atualização)

Range("C5").Select

Set Ws2 = Sheets("LANCAR COMISSAO") 'Referencia a guia LANÇAR COMISSAO como Ws2

Set Dest = Ws2.Range("B3").Range("B52").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)

Range("AA3:AG3").Copy 'Copia o intervalo AB2:AG2 da guia Resumo

Dest.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
Application.CutCopyMode = False 'Desativaj o clipboard

 
Postado : 29/11/2015 6:54 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Ainda bem que resolveu, e sinceramente, não vi relação das instruções que colocou com o que você estava querendo, "Alocar na memoria", mas deve estar sendo mau entendimento da minha parte.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 29/11/2015 7:49 pm