Ocultar Tabelas 2013

Boa tarde Amigos

Na versão 2007 funcionava perfeito agora na versão 2013 depois de executar o código, funciona mas quando reabrir a BD e tentar alterar o VBA da BD informa o seguinte:



E depois não se consegue alterar ou adicionar o VBA

PS - BD não dividida

Private Sub Comando213_Click()
On Error Resume Next
If MsgBox("Ocultar as Tabelas ? ", vbYesNo + vbQuestion, "Aviso ") = vbYes Then
DoCmd.SetWarnings False
Dim Tb As TableDef
For Each Tb In CurrentDb.TableDefs
Rem  MsgBox Tb.Name
If Not Tb.Attributes And dbHiddenObject Then
Tb.Attributes = Tb.Attributes Or dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Foram Ocultas. ", vbExclamation, "Aviso "
Else
For Each Tb In CurrentDb.TableDefs
If Tb.Attributes And dbHiddenObject Then
Tb.Attributes = Tb.Attributes Xor dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Estão Visíveis. ", vbExclamation, "Aviso "
Exit Sub
End If
Exit Sub
End Sub

Olá


Como dizemos nesse mundo da programação, todo dia é um aprendizado.

Estou ainda analisando.

Veja!

Coloquei seu código num projeto que tenho 12 tabelas vários outros forms consultas e tal.
Na primeira utilização me retornou o erro apresentado a vc.

Diante disso, criei um novo db e fiz 6 teste dentro de um form com 3 tbls.

1º Teste, foi com seu código resultado sem erros

2º Teste, foi dividir seu código e executar somente exibir, resultado sem erros

3º Teste, foi dividir seu código e executar somente ocultar, resultado sem erros

4º Teste, foi alterar seu código em uma unica linha, resultado sem erros

5º Teste, foi alterar seu código em uma unica linha e dividir ele em somente exibir, resultado sem erros

6º Teste, foi alterar seu código em uma unica linha e dividir ele em somente ocultar, resultado sem erros


Segue abaixo os códigos utilizados nos teste num novo db access 2013.

E ai que vem o motivo da minha frase no inicio dessa resposta, pois não tenho uma conclusão bem exata do porque o db estando carregado o erro surge.

Digo carregado porque alem dos teste que fiz acima, utilizei teste com 12 tbls vazias e 12 tabelas cheias.

As vazias não retornaram erro. Já as cheias com 200 registros cada, de imediato apresentaram o erro.

Algo a ser analisado com calma.

Tenho um palpite que possa ser referente a condição de cada campo dentro das tabelas.

Ou até mesmo por se tratar de alteração na estrutura do db geral, esteja sendo armazenado no próprio processo e serviço do windows dando a entender que este db já esteja aberto.

Mas breve terei a resposta.

No mais, tente criar um novo db e realize os teste que fiz para verificar se fluirá.


Abraços


Código dos teste

Option Compare Database
Private Sub btn_exibir_Click()
On Error Resume Next
MsgBox "exibir as Tabelas! ", vbYes + vbInformation, "Aviso"
DoCmd.SetWarnings False
Dim Tb As TableDef
For Each Tb In CurrentDb.TableDefs
If Tb.Attributes And dbHiddenObject Then
Tb.Attributes = Tb.Attributes Xor dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Estão Visíveis. ", vbExclamation, "Aviso "
Exit Sub
End Sub

Private Sub btn_ocultar_Click()
On Error Resume Next
MsgBox "Ocultar as Tabelas! ", vbYes + vbInformation, "Aviso"
DoCmd.SetWarnings False
Dim Tb As TableDef
For Each Tb In CurrentDb.TableDefs
Rem MsgBox Tb.Name
If Not dbHiddenObject Then
Tb.Attributes = dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Foram Ocultadas. ", vbExclamation, "Aviso "
Exit Sub
End Sub
Private Sub btn_seucodigoalterado_Click()
On Error Resume Next
If MsgBox("Ocultar as Tabelas ? ", vbYesNo + vbQuestion, "Aviso ") = vbYes Then
DoCmd.SetWarnings False
Dim Tb As TableDef
For Each Tb In CurrentDb.TableDefs
Rem MsgBox Tb.Name
If Not Tb.Attributes And dbHiddenObject Then
Tb.Attributes = dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Foram Ocultas. ", vbExclamation, "Aviso "

Else

For Each Tb In Current
Db.TableDefs
If Tb.Attributes And dbHiddenObject Then
Tb.Attributes = Tb.Attributes Xor dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Estão Visíveis. ", vbExclamation, "Aviso "
Exit Sub
End If
End Sub
Private Sub btn_seucodigo_Click()
On Error Resume Next
If MsgBox("Ocultar as Tabelas ? ", vbYesNo + vbQuestion, "Aviso ") = vbYes Then
DoCmd.SetWarnings False
Dim Tb As TableDef
For Each Tb In CurrentDb.TableDefs
Rem MsgBox Tb.Name
If Not Tb.Attributes And dbHiddenObject Then
Tb.Attributes = Tb.Attributes Or dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Foram Ocultas. ", vbExclamation, "Aviso "
Else
For Each Tb In CurrentDb.TableDefs
If Tb.Attributes And dbHiddenObject Then
Tb.Attributes = Tb.Attributes Xor dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Estão Visíveis. ", vbExclamation, "Aviso "
Exit Sub
End If
Exit Sub
End Sub
Private Sub btnseucodexibir_Click()
On Error Resume Next
MsgBox "Exibir as Tabelas", vbYes + vbQuestion, "Aviso "
DoCmd.SetWarnings False
Dim Tb As TableDef
For Each Tb In CurrentDb.TableDefs
If Tb.Attributes And dbHiddenObject Then
Tb.Attributes = Tb.Attributes Xor dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Estão Visíveis. ", vbExclamation, "Aviso "
Exit Sub
End Sub

Private Sub btnseucodocultar_Click()
On Error Resume Next
MsgBox "Ocultar as Tabelas", vbYes + vbQuestion, "Aviso "
DoCmd.SetWarnings False
Dim Tb As TableDef
For Each Tb In CurrentDb.TableDefs
Rem MsgBox Tb.Name
If Not Tb.Attributes And dbHiddenObject Then
Tb.Attributes = Tb.Attributes Or dbHiddenObject
End If
Next
MsgBox "Todas As Tabelas Foram Ocultas. ", vbExclamation, "Aviso "
Exit Sub
End Sub