Salvar Com Nome Contido Em Célula (data E Hora)

[Guest José da Consolação]

O código abaixo permite gravar o arquivo com o nome data contida em uma célula (data do dia). Todavia se tiver que gravar o mesmo arquivo mais de uma vez no mesmo dia, terei que sobrepor. Gostaria de um código que diferencie um de outro com a mesma data, exemplo data mais a hora (função =agora)(). QUEM PUDER ME AJUDAR AGRADEÇO.

Só pra recapitular, preciso de adicionar ao código de salvar pelo conteúdo da célula (data e hora) para que se eu necessitar de salvar mais de uma vez no dia, ele seja diferente pois não existe dois horários iguais no mesmo dia, logo se eu precisar de salvar novamente o arquivo, este será gravado com outro nome, ou seja em horário diferente. Pois no horário em que está sendo salvo lhe será atribuido o nome do arquivo.

Exemplo:

25/3/2007 20:04.xls

Conto com sua ajuda

Sub GravaPasta()

Dim data As String

data = Day(CDate(Sheets("Plan1").Range("A1").Value))

data = data & Month((CDate(Sheets("Plan1").Range("A1").Value)))

data = data & Year((CDate(Sheets("Plan1").Range("A1").Value)))

ChDir "C:\meus documentos\jose da consolacao"

ActiveWorkbook.SaveAs Filename:="C:\meus documentos\jose da consolacao\" & data & ".xls", FileFormat:=xlNormal, _

Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

CreateBackup:=False

End Sub

[Graymalkin]

Inclua a hora também, assim como você fez com a data. As funções de hora são Hour(), Minute() e Second().

Abraços,

Graymalkin

[Guest --Andre --]

Inclua a hora também, assim como você fez com a data. As funções de hora são Hour(), Minute() e Second().

Abraços,

Graymalkin

A funcao time() já resolve!

Abracos!

Andre

[Guest Sir]

A macro ficará assim no final

Sub GravaPasta()

Dim data As String

nome = Range("n2").Value ‘ Pega nome existente na planilha na célula N2 e atribui a variável nome

data = Now() ' Agora() - data e hora atual obtida do sistema – se quiser de uma célula indique-a

‘ data= range(“a2”).value ‘ se quiser pegar valor existente na célula A2

'removenndo barras e dois pontos para ficar só os numeros de data e hora separados por hífen ddmmaaaa-hhmmss

data = Left(data, 2) & Mid(data, 4, 2) & Mid(data, 7, 4) & "-" & Mid(data, 12, 2) & Mid(data, 15, 2) & Right(data, 2)

ChDir "c:\Testes de Macro" 'alterna para o diretório indicado

ActiveWorkbook.SaveAs Filename:="c:\Testes de Macro\" & nome & data & ".xls", FileFormat:=xlNormal, _

Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

CreateBackup:=False

End Sub