...The code is very large.
Public Const nomePlanilhaCadastro As String = "Fornecedores"
Public Const nomePlanilhaProdutos As String = "Produtos"
Public Const nomePlanilhaMovimento As String = "Movimentacao"
Public Const nomePlanilhaGrafico As String = "Charts"
'Os objetos Worksheet representam as planilhas
Public wsCadastro As Worksheet 'Planilha Fornecedores
Public wsProdutos As Worksheet 'Planilha Produtos
Public wsMovimento As Worksheet 'Planilha Movimentacao
Public wsGrafico As Worksheet 'Planilha Graficos
'Workbook representa uma pasta de trabalho
Public wbCadastro As Workbook 'ARQUIVO_DADOS = Dados_BDs.xls
Public sConsulta As Boolean
Public xClose As Boolean
'Alterado para para Public, para poder ser usado em todos os Formulários
Public Sub FecharBD(Cancel As Integer, CloseMode As Integer)
'fecha a planilha de dados, se estiver aberta
If Not wbCadastro Is Nothing Then
wbCadastro.Saved = True
wbCadastro.Close SaveChanges:=False
End If
Set wbCadastro = Nothing
End Sub
'Alterado para para Public, para poder ser usado em todos os Formulários
Public Sub DefinePlanilhaDados()
Dim abrirArquivo As Boolean
Dim wb As Workbook
Dim caminhoCompleto As String
Dim ARQUIVO_DADOS As String
Dim PASTA_DADOS As String
abrirArquivo = True
'sConsulta = False
ARQUIVO_DADOS = Range("ARQUIVO_DADOS").Value
PASTA_DADOS = Range("PASTA_DADOS").Value
If ThisWorkbook.Name <> ARQUIVO_DADOS Then
'monta a string do caminho completo
If PASTA_DADOS = vbNullString Or PASTA_DADOS = "" Then
caminhoCompleto = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_DADOS
Else
If Right(PASTA_DADOS, 1) = "\" Then
caminhoCompleto = PASTA_DADOS & ARQUIVO_DADOS
Else
caminhoCompleto = PASTA_DADOS & "\" & ARQUIVO_DADOS
End If
End If
'verifica se o arquivo não está aberto
For Each wb In Application.Workbooks
If wb.Name = ARQUIVO_DADOS Then
abrirArquivo = False
Exit For
End If
Next
'atribui o arquivo
If abrirArquivo Then
Set wbCadastro = Workbooks.Open(FileName:=caminhoCompleto, ReadOnly:=True)
Else
Set wbCadastro = Workbooks(ARQUIVO_DADOS)
End If
Else
Set wbCadastro = ThisWorkbook
End If
'Referencia as 3 Planilhas da pasta wbCadastro
Set wsCadastro = wbCadastro.Worksheets(nomePlanilhaCadastro) 'Planilha Fornecedores
Set wsProdutos = wbCadastro.Worksheets(nomePlanilhaProdutos) 'Planilha Produtos
Set wsMovimento = wbCadastro.Worksheets(nomePlanilhaMovimento) 'Planilha Movimentacao
Set wsGrafico = wbCadastro.Worksheets(nomePlanilhaGrafico)
'oculta o arquivo de dados
wbCadastro.Windows(1).Visible = False
End Sub