Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Salvando com Nome
 
Notifications
Clear all

Salvando com Nome

 
2024 - VBA & Macros
Post Recente por Tomoiti 11 anos atrás
10 Posts
2 Usuários
0 Reactions
1,669 Visualizações
RSS
 Tomoiti
(@tomoiti)
Posts: 41
Trusted Member
Topic starter
 

Boa Tarde pessoal,

Criei essa macro, que copia a planilha, depois copio por cima só os valores tirando as formulas.
tiro ela para um arquivo novo. depois disso queria que ela salvasse em um diretório específico "C: bla bla" com o nome "F8" - Requisição - "B6".(um formato que transformasse ele em uma arquivo excel leve).

Sub FINALIZAR()
'
' FINALIZAR Macro
'

'
    Sheets("PEDIDO").Select
    Sheets("PEDIDO").Copy Before:=Sheets(1)
    Range("J4").Select
    ActiveSheet.Shapes.Range(Array("Button 1", "Button 2")).Select
    Selection.Delete
    Range("A1").Select
    Sheets("PEDIDO (2)").Select
    Sheets("PEDIDO (2)").Name = "MIMAKI BR"
    Range("A1").Select
    Sheets("PEDIDO").Select
    Range("B4:B10").Select
    Selection.Copy
    Sheets("MIMAKI BR").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO").Select
    Range("F6:G6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MIMAKI BR").Select
    Range("F6:G6").Select
    ActiveSheet.Paste
    Sheets("PEDIDO").Select
    Range("F8:G8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MIMAKI BR").Select
    Range("F8:G8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO").Select
    Range("F6:G6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MIMAKI BR").Select
    Range("F6:G6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO").Select
    Range("F10:G10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MIMAKI BR").Select
    Range("F10:G10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO").Select
    ActiveWindow.SmallScroll Down:=9
    Range("A15:I34").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MIMAKI BR").Select
    Range("A15:I34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO").Select
    ActiveWindow.SmallScroll Down:=15
    Range("B39:B46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MIMAKI BR").Select
    ActiveWindow.SmallScroll Down:=18
    Range("B39").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO").Select
    ActiveWindow.SmallScroll Down:=12
    Range("B48:C68").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MIMAKI BR").Select
    Range("B49").Select
    Range("B48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-48
    Range("A1").Select
    Sheets("PEDIDO").Select
    ActiveWindow.SmallScroll Down:=-63
    Range("A1").Select
    Sheets("MIMAKI BR").Select
    Application.CutCopyMode = False
    Sheets("MIMAKI BR").Move
End Sub
 
Postado : 03/06/2013 2:46 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Tente 

Sub teste()
ThisWorkbook.SaveAs _
    "C:Documents and SettingsAll UsersDesktop - B6" & strLast, xlWorkbookNormal

End Sub
 
Postado : 04/06/2013 4:11 am
 Tomoiti
(@tomoiti)
Posts: 41
Trusted Member
Topic starter
 

Alexandre, você pode me explicar(Desmembrar) essa linha?

 "C:Documents and SettingsAll UsersDesktop - B6" & strLast, xlWorkbookNormal
 
Postado : 04/06/2013 10:26 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

O caminho mais o nome de seu arquivo!!

Para entender melhor leia:
http://msdn.microsoft.com/en-us/library ... 41185.aspx
http://www.rondebruin.nl/win/s5/win001.htm

Alguma coisa ainda está errado?...não conseguiu adaptar?

Att

 
Postado : 04/06/2013 4:49 pm
 Tomoiti
(@tomoiti)
Posts: 41
Trusted Member
Topic starter
 

Obrigado pela ajuda Alexandre, :D

Mas não deu certo. :cry:

Quero q ele salve a planilha que foi solta e não a master.

e o nome desta novo arquivo deve ser "celulaF8" - Requisição - "celulaB6".(um formato que transformasse ele em uma arquivo excel leve).

o diretório do seva tbm é especifico "C: bla bla"

caso haja algum problema que ele me aparece um msg. tipo " Nao foi possivel salvar no local padrão, escolha outro endereço."

Apos esse erro ele deveria abrir o salvar como, com o nome pré escrito "celulaF8" - Requisição - "celulaB6".(um formato que transformasse ele em uma arquivo excel leve)

Tem como fazer isso Alexandre? :twisted:

 
Postado : 04/06/2013 6:34 pm
 Tomoiti
(@tomoiti)
Posts: 41
Trusted Member
Topic starter
 

Consegui!!!!

ActiveWorkbook.SaveAs "C:UsersTOMOITIDesktopTESTE MMK" & [F8].Value & " - REQUISIÇAO - " & [B6].Value & ".xls"

porem se eu salvar duas vezes ele da pau...

sera q alguem poderia me ajudar???

 
Postado : 04/06/2013 7:37 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Veja em
http://www.ozgrid.com/VBA/save-as-cell.htm 

Sub teste2()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="C:Documents" & Range("A1"), _
FileFormat:=(As desired), _
CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close SaveChanges:=False

End Sub

Ou..

Option Explicit 
 
Sub Teste() 
     
    Dim FName           As String 
    Dim FPath           As String 
     
    FPath = "C:" 
    FName = Sheets("Plan1").Range("A1").Text 
    ThisWorkbook.SaveAs Filename:=FPath & "" & FName 
     
End Sub

Att

 
Postado : 04/06/2013 7:50 pm
 Tomoiti
(@tomoiti)
Posts: 41
Trusted Member
Topic starter
 

Ainda não funcionou...

só funciona redondo quando não há o arquivo com o mesmo nome...

pq se tiver o mesmo nome ele empaca...

ai meu deus! Só falta isso para acabar :(

 
Postado : 04/06/2013 8:52 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Infelizmente isso acontece, use uma função para verificar um arquivo já existente!

Lembre se de usar a pesquisa do fórum!!!
Fonte:
http://www.excelguru.ca/content.php?157 ... ry-(Folder)-Exists

Public Function FileFolderExists(strFullPath As String) As Boolean
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Check if a file or folder exists
    On Error GoTo EarlyExit
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
    
EarlyExit:
    On Error GoTo 0
End Function
Public Sub TestFolderExistence()
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Test if directory exists
    If FileFolderExists("F:Templates") Then
        MsgBox "Folder exists!"
    Else
        MsgBox "Folder does not exist!"
    End If
End Sub
Public Sub TestFileExistence()
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Test if directory exists
    If FileFolderExists("F:TestTestWorkbook.xls") Then
        MsgBox "File exists!"
    Else
        MsgBox "File does not exist!"
    End If
End Sub
 
Postado : 05/06/2013 5:42 pm
 Tomoiti
(@tomoiti)
Posts: 41
Trusted Member
Topic starter
 

RESOLVIDO! OBRIGADO A TODOS!!!!

 
Postado : 11/06/2013 1:48 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico