[Resolvido]Como modificar a máscara de entrada de um campo da tabela via VBA?

Bom dia amigos,

É o seguinte: No meu formulário pelo evento Form_Open, gostaria que o usuário modificasse a máscara de entrada de um determinado campo a seu gosto antes da inserção de registros, mas que padronizasse sua máscara na tabela também, porque se fecho o formulário a máscara criada desaparece. Não entendo o porquê da propriedade InputMask não funcionar no sentido de gravar também na tabela. Pesquisei aqui e em outros fóruns e descobri alguns códigos. O primeiro tentei e não funcionou, o segundo não sei como modificá-lo para me atender para o meu propósito. Alguém pode me ajudar?

(1)
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next

If IsNull(ORDEMDESERVICO) Or IsNull(CODIGOCLIENTE) Then
Dim mascEntrada As String
Dim sMascara As String

mascEntrada = InputBox("Defina a máscara de entrada para este campo(ORDEM DE SERVIÇO).Ex.: 000.0000-0 : ", "Controle de OS")
ORDEMDESERVICO.InputMask = "" & mascEntrada & ""
ORDEMDESERVICO = Format(ORDEMDESERVICO, "" & mascEntrada & "")

sMascara = InputBox("Defina a máscara de entrada para este campo(CODIGOCLIENTE).Ex: 000000-0: ", "Controle de OS")
CODIGOCLIENTE.InputMask = "" & sMascara & ""
CODIGOCLIENTE = Format(CODIGOCLIENTE, "" & sMascara & "")

Else

ORDEMDESERVICO.InputMask = "" & mascEntrada & ""
ORDEMDESERVICO = Format(ORDEMDESERVICO, "" & mascEntrada & "")
CODIGOCLIENTE.InputMask = "" & sMascara & ""
CODIGOCLIENTE = Format(CODIGOCLIENTE, "" & sMascara & "")

End If
End Sub

(2)
Dim Entrada As String
Dim StrSQLCriaCampo As String
Dim db As DAO.Database

Entrada = InputBox("Insira o nome do Campo", "Aviso")
StrSQLCriaCampo = "ALTER TABLE TABELA ADD COLUMN [" & Entrada & "] DOUBLE;"
Set db = CurrentDb
db.Execute StrSQLCriaCampo

Dim tdef As DAO.TableDef
Dim fdef As DAO.Field
Dim pdef As DAO.Property

Set db = CurrentDb()
Set tdef = db.TableDefs("TABELA")
Set fdef = tdef.Fields(Entrada)
DoCmd.RunSQL "ALTER TABLE TABELA ALTER COLUMN [" & Entrada & "] DOUBLE"
Set pdef = fdef.CreateProperty("Format", dbText, "Fixed")
fdef.Properties.Append pdef
db.TableDefs("TABELA").Fields(Entrada).Properties("Format") = "Fixed"
db.Close
Set db = Nothing

End Sub

Boa tarde, good guy
O 1º código coloca a máscara de entrada no controlo e não no campo
Para alterar no campo a máscara de entrada, tente o seguinte

Sub AlteraMascara()
Dim Campo As DAO.Field
Dim Entrada As String

Entrada = InputBox("Insira o nome do Campo", "Aviso")
Set Campo = CurrentDb.TableDefs("Tabela").Fields(Entrada)
sMascara = InputBox("Defina a máscara de entrada para este campo(" & Entrada &").Ex: 000000-0: ", "Controle de OS")
Campo.Properties.Append campo.CreateProperty("InputMask", dbText, sMascara & ";0;_")
Set Campo = Nothing
End Sub

Olá Alexandre,

Cheguei do almoço agora. Obrigado pela resposta. Tenho certeza de que vai dar certo. Amigo, só falta este código para fechar o aplicativo que desenvolvi para o meu site. Vai ajudar muitos outros colegas também. Vou testá-lo e depois respondo. OK?

Olá Alexandre,

Modifiquei o código para incluir os nomes reais dos campos que desejo modificar a máscara de entrada.

Sub AlteraMascaraOS()
Dim Campo As DAO.Field
Dim Entrada As String
Dim sMascara As String

Entrada = InputBox("Digite ORDEMDESERVICO:", "Aviso")
Set Campo = CurrentDb.TableDefs("tbl_OS").Fields(Entrada)
sMascara = InputBox("Defina a máscara de entrada para este campo(" & Entrada & ").Ex: 000000-0: ", "Controle de OS")
Campo.Properties.Append Campo.CreateProperty("InputMask", dbText, sMascara & ";0;_")
Set Campo = Nothing
End Sub


Sub AlteraMascaraCC()
Dim Campo As DAO.Field
Dim Entrada As String
Dim sMascara As String

Entrada = InputBox("Digite CODIGOCLIENTE", "Aviso")
Set Campo = CurrentDb.TableDefs("tbl_OS").Fields(Entrada)
sMascara = InputBox("Defina a máscara de entrada para este campo(" & Entrada & ").Ex: 000000-0: ", "Controle de OS")
Campo.Properties.Append Campo.CreateProperty("InputMask", dbText, sMascara & ";0;_")
Set Campo = Nothing
End Sub

Private Sub Form_Open(Cancel As Integer)
On Error Resume Next

If IsNull(ORDEMDESERVICO) Or IsNull(CODIGOCLIENTE) Then
Call AlteraMascaraOS
Call AlteraMascaraCC
End If
End Sub

Mas, infelizmente, não ocorreu nenhuma alteração após digitar o nome do campo e sua máscara. Onde é que eu errei?

Olá good guy
Para o 1º procedimento
Sub AlteraMascaraOS()
'código criado por Alexandre Neves, do Fórum MaximoAccess
'em 2013-05-07 para good guy
'o código pode ser utilizado livremente, desde que mencionado este cabeçalho
Dim Bd As DAO.Database, Tbl As DAO.TableDef, Cmp As DAO.Field, Prp As DAO.Property
Dim Entrada As String, sMascara As String

Entrada = InputBox("Digite ORDEMDESERVICO:", "Aviso")
sMascara = InputBox("Defina a máscara de entrada para este campo(" & Entrada & ").Ex: 000000-0: ", "Controle de OS")

Set Bd = CurrentDb
Set Tbl = Bd.TableDefs("tbl_OS")
Set Cmp = Tbl.Fields(Entrada)
Set Prp = Cmp.CreateProperty("InputMask", dbText, sMascara & ";0;_")
Cmp.Properties.Append Prp

Bd.TableDefs.Refresh

Set Cmp = Nothing
Set Tbl = Nothing
Set Bd = Nothing
End Sub

Execelente Alexandre,

Funcionou beleza. Só falta um detalhe: Como faço para o caso do usuário desejar apagar ou limpar a máscara de entrada que ele próprio criou, caso queira trocar por uma outra via código?

Boa tarde, good guy
Continua:
Sub AlteraMascaraOS()
'código criado por Alexandre Neves, do Fórum MaximoAccess
'em 2013-05-08 para good guy
'o código pode ser utilizado livremente, desde que mencionado este cabeçalho
Dim Bd As DAO.Database, Tbl As DAO.TableDef, Cmp As DAO.Field, Prp As DAO.Property
Dim Entrada As String, sMascara As String

Entrada = InputBox("Digite ORDEMDESERVICO:", "Aviso")
sMascara = InputBox("Defina a máscara de entrada para este campo(" & Entrada & ").Ex: 000000-0: ", "Controle de OS")

Set Bd = CurrentDb
Set Tbl = Bd.TableDefs("tbl_OS")
Set Cmp = Tbl.Fields(Entrada)
Set Prp = Cmp.CreateProperty("InputMask", dbText, sMascara & ";0;_")Cmp.Properties.Append Prp

Bd.TableDefs.Refresh

Set Cmp = Nothing
Set Tbl = Nothing
Set Bd = Nothing
Exit Sub
TrataErro:
If err.Number = 3367 Then Cmp.Properties.Delete ("InputMask"):GoTo Continua
End Sub

Olá Alexandre,

O código funciona beleza, mas não altera a máscara anterior na tabela. Continua com a mesma máscara mesmo depois de eu ter trocado de máscara.

Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
'código criado por Alexandre Neves, do Fórum MaximoAccess
'em 2013-05-07 para good guy
'o código pode ser utilizado livremente, desde que mencionado este cabeçalho
Continua:

Dim Bd As DAO.Database, Tbl As DAO.TableDef, Cmp As DAO.Field, Prp As DAO.Property
Dim Entrada As String, sMascara As String

Entrada = InputBox("Digite abaixo: CODIGO", "Aviso")
sMascara = InputBox("Defina a máscara de entrada para este campo(" & Entrada & ").Ex: 000,000-0(RESULTADO: 000.000-0): ", "CÓDIGOS DE OS")
Me.CODIGO.InputMask = "" & sMascara & "" 'Inclui esta linha porque no formulário a máscara criada não entra, só na tabela e isto acontece só na primeira vez. Quando troco de máscara funciona no formulário, mas na tabela continua com a mesma máscara. Se tiro esta linha, não funciona a máscara gerada pelo seu código no formulário e nem altera nada na tabela. Preciso desta linha pelo menos.

Set Bd = CurrentDb
Set Tbl = Bd.TableDefs("CodigosdeOS")
Set Cmp = Tbl.Fields(Entrada)
Set Prp = Cmp.CreateProperty("InputMask", dbText, sMascara & ";0;_")
Cmp.Properties.Append Prp

Bd.TableDefs.Refresh

Set Cmp = Nothing
Set Tbl = Nothing
Set Bd = Nothing
Exit Sub
TrataErro:
If err.Number = 3367 Then Cmp.Properties.Delete ("InputMask"): GoTo Continua

End Sub

Fica assim na tabela:
CODIGO TIPOSERVICO
00000101 INSTALAR VÁLVULA
___-_

Desculpa, não adaptei correctamente
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
'código criado por Alexandre Neves, do Fórum MaximoAccess
'em 2013-05-07 para good guy
'o código pode ser utilizado livremente, desde que mencionado este cabeçalho
Dim Bd As DAO.Database, Tbl As DAO.TableDef, Cmp As DAO.Field, Prp As DAO.Property
Dim Entrada As String, sMascara As String

Entrada = InputBox("Digite abaixo: CODIGO", "Aviso")
sMascara = InputBox("Defina a máscara de entrada para este campo(" & Entrada & ").Ex: 000,000-0(RESULTADO: 000.000-0): ", "CÓDIGOS DE OS")
Me.CODIGO.InputMask = "" & sMascara & "" 'Inclui esta linha porque no formulário a máscara criada não entra, só na tabela e isto acontece só na primeira vez. Quando troco de máscara funciona no formulário, mas na tabela continua com a mesma máscara. Se tiro esta linha, não funciona a máscara gerada pelo seu código no formulário e nem altera nada na tabela. Preciso desta linha pelo menos.

Set Bd = CurrentDb
Set Tbl = Bd.TableDefs("CodigosdeOS")
Set Cmp = Tbl.Fields(Entrada)
Set Prp = Cmp.CreateProperty("InputMask", dbText, sMascara & ";0;_")
Continua:
Cmp.Properties.Append Prp

Bd.TableDefs.Refresh

Set Cmp = Nothing
Set Tbl = Nothing
Set Bd = Nothing
Exit Sub
TrataErro:
If err.Number = 3367 Then Cmp.Properties.Delete ("InputMask"): GoTo Continua

End Sub

Olá Alexandre,

Continua a mesma coisa. Quando troco de máscara, não altera a máscara do campo CODIGO na tabela. Checa aí. Teria que limpar a máscara anterior para depois aceitar a nova máscara.

Aqui funcionou
Sub AlteraMascaraDeCampo()
'código criado por Alexandre Neves, do Fórum MaximoAccess
'em 2013-05-07 para good guy
'o código pode ser utilizado livremente, desde que mencionado este cabeçalho
On Error GoTo TrataErro
Dim Bd As DAO.Database, Tbl As DAO.TableDef, Cmp As DAO.Field, Prp As DAO.Property
Dim Entrada As String, sMascara As String

Entrada = InputBox("Digite ORDEMDESERVICO:", "Aviso")
sMascara = InputBox("Defina a máscara de entrada para este campo(" & Entrada & ").Ex: 000000-0: ", "Controle de OS")
Set Bd = CurrentDb
Set Tbl = Bd.TableDefs("tbl_OS")
Set Cmp = Tbl.Fields(Entrada)
Set Prp = Cmp.CreateProperty("InputMask", dbText, sMascara & ";0;_")
Continua:
Cmp.Properties.Append Prp

Bd.TableDefs.Refresh

Set Cmp = Nothing
Set Tbl = Nothing
Set Bd = Nothing
Exit Sub
TrataErro:
If err.Number = 3367 Then Cmp.Properties.Delete ("InputMask"): GoTo Continua
End Sub

Grande Alexandre. Valew, funcionou a contento. Obrigado !!!