Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
"Abrir", ...
 
Notifications
Clear all

"Abrir", "Editar" e "Salvar como" arquivo *.xlsm

 
2024 - VBA & Macros
Post Recente por Eric Jhon 9 anos atrás
6 Posts
3 Usuários
0 Reactions
1,905 Visualizações
RSS
 Eric Jhon
(@eric-jhon)
Posts: 0
New Member
Topic starter
 

Boa tarde, pessoal.

Como faço para abrir uma pasta de trabalho habilitada para macro via vba sem mostrar na interface do usuário, inserir dados nela e salvar como um novo arquivo *.xlsm em uma outra pasta do computador?

Eu estou utilizando GetObject() para abrir o Workbook "MatrizFérias.xlsm" que está na mesma pasta do Workbook que está o banco de dados e o formulário.

 Arquivo = ThisWorkbook.Path & "" & "MatrizFérias.xlsm"
Set MatrizFérias = GetObject(Arquivo)

Até ai tudo bem, consigo abrir e inserir os dados. Mas não consigo salvar uma cópia de "MatrizFérias.xlsm" como "Nome.xlsm" com os dados inseridos e fechar o arquivo recém criado. E quando salva não consigo abrir o arquivo recém criado.

Grato!

 
Postado : 29/10/2015 12:36 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Tente isso..

Sub AleVBA_17920()
    Dim i As Integer
    Dim Filname As String
    Dim sName As String
     
     
    Filname = "AleVBA"
    sName = Application.GetSaveAsFilename(Filname, "Pasta de Trabalho Habilitada para Macro do Excel(*.xlsm), *.xlsm")
    If Filname = "False" Then
        Exit Sub
    End If
     
    Plan1.Range("A1:B3").Copy Plan2.Range("A1") 'Intervalo definido á ser copiado
    Plan2.Copy
    ActiveWorkbook.SaveAs sName & Filname
    ActiveWorkbook.Close
End Sub

Não testado.
Att

 
Postado : 29/10/2015 12:51 pm
 Eric Jhon
(@eric-jhon)
Posts: 0
New Member
Topic starter
 

Boa tarde!!

Tente isso..

Código: Selecionar todos
Sub AleVBA_17920()
Dim i As Integer
Dim Filname As String
Dim sName As String

Filname = "AleVBA"
sName = Application.GetSaveAsFilename(Filname, "Pasta de Trabalho Habilitada para Macro do Excel(*.xlsm), *.xlsm")
If Filname = "False" Then
Exit Sub
End If

Plan1.Range("A1:B3").Copy Plan2.Range("A1") 'Intervalo definido á ser copiado
Plan2.Copy
ActiveWorkbook.SaveAs sName & Filname
ActiveWorkbook.Close
End Sub

Não testado.
Att

alexandrevba, infelizmente também não funcionou. Após o salvamento o arquivo abre, mas não mostra nenhuma planilha. O mesmo que acontece com o GetObject() :-/

 
Postado : 29/10/2015 1:30 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Disponibilize os arquivos que vc precisa criar

 
Postado : 29/10/2015 1:56 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Tente assim..

Sub AleVBA_17920V2()
    Dim bFileSaveAs As Boolean
    bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
    If Not bFileSaveAs Then MsgBox "Cancelado", vbCritical
End Sub

Você escolherá o arquivo, salva no formato e nome que desejar.

Att

 
Postado : 29/10/2015 2:16 pm
 Eric Jhon
(@eric-jhon)
Posts: 0
New Member
Topic starter
 

Boa tarde!!

Tente assim..

Sub AleVBA_17920V2()
    Dim bFileSaveAs As Boolean
    bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
    If Not bFileSaveAs Then MsgBox "Cancelado", vbCritical
End Sub

Você escolherá o arquivo, salva no formato e nome que desejar.

Att

Infelizmente também não certo. Mas consegui resolver meu problema da seguinte forma:

Dim Resultado As VbMsgBoxResult
    Resultado = MsgBox("Deseja imprimir a Ficha Nº " & IDServidor & " de " & Nome & " do registro?", vbYesNo + vbQuestion, "Gerenciamento de Servidores")
If Resultado = vbNo Then
    Else

Application.ScreenUpdating = False

Workbooks.Open Filename:=ThisWorkbook.Path & "" & "MatrizServidor.xlsm"

        Workbooks("MatrizServidor").ActiveSheet.Range("A10") = IDServidor.Value
        Workbooks("MatrizServidor").ActiveSheet.Range("E10") = Nome.Value
        Workbooks("MatrizServidor").ActiveSheet.Range("AC10") = DTNascimento.Value
        Workbooks("MatrizServidor").ActiveSheet.Range("AH10") = Sexo.Value
        Workbooks("MatrizServidor").ActiveSheet.Range("AM10") = Nacionalidade.Value
        Workbooks("MatrizServidor").ActiveSheet.Range("AR10") = Naturalidade.Value
        Workbooks("MatrizServidor").ActiveSheet.Range("A12") = NomePai.Value
        
Workbooks("MatrizServidor").SaveAs Filename:=ThisWorkbook.Path & "" & "Fichas Individuais" & "" & IDServidor & " - " & Nome & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

        Workbooks(IDServidor & " - " & Nome & ".xlsm").Close
End If
Application.ScreenUpdating = True

Funcionou perfeitamente!
Obrigado a todos!
Deus vos abençoe!

 
Postado : 30/10/2015 2:23 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico