[Anónimo]

boa tarde galerinha!!

para proteger o arquivo por vba, eu utilizo da programa abaixo, porém ele só me pede uma única vez a senha, eu gostaria que pedisse 2 vezes (confirmação da senha), igual qdo é feito direto pela caixa de ferramenta do excel. onde tenho que alterar?
______________________________________________________________

sub proteger()

application.screenupdating = false

sbdesproteger = “digite uma senha para proteger o arquivo.” & vbcrlf _

sbtitulo = “wagner goularte”

for each wsplan in activeworkbook.worksheets
if wsplan.protectcontents = true then
msgbox “arquivo já está protegido!!!” & vbcrlf _
, vbcritical, “wagner goularte”
exit sub
end if
next wsplan

sbproteger = application.inputbox(prompt:=sbdesproteger, title:=sbtitulo, default:=””, type:=2)

if sbproteger = ok then
if sbproteger = “” then
msgbox “digite uma senha !!!”
sbproteger = application.inputbox(prompt:=sbdesproteger, title:=sbtitulo, default:=””, type:=2)
end if
else

if sbproteger = cancel then
exit sub
end if

if sbproteger = vbcancel then
msgbox “arquivo não foi protegido!!!” & vbcrlf _
, vbcritical, “wagner goularte”
exit sub
end if

for each wsplan in activeworkbook.worksheets
wsplan.protect password:=sbproteger, drawingobjects:=true, contents:=true, scenarios:=true, _
allowfiltering:=true, allowformattingcells:=true, allowformattingcolumns:=true, _
allowformattingrows:=true, allowinsertingcolumns:=true, allowinsertingrows:=true, _
allowinsertinghyperlinks:=true, allowdeletingcolumns:=true, allowdeletingrows:=true, _
allowsorting:=true, allowusingpivottables:=true

next wsplan

msgbox “arquivo protegido com sucesso!!!”

sbproteger = empty

application.screenupdating = true

end if

end sub

_________________________________________________________

aguardo resposta.
grato !!!!

[jorgerod]

boas, wagner!!

talvez qualquer coisa, como:

sub proteger()

application.screenupdating = false

sbdesproteger = “digite uma senha para proteger o arquivo.” & vbcrlf _

sbtitulo = “wagner goularte”

for each wsplan in activeworkbook.worksheets
if wsplan.protectcontents = true then
msgbox “arquivo já está protegido!!!” & vbcrlf _
, vbcritical, “wagner goularte”
exit sub
end if
next wsplan

sbproteger = application.inputbox(prompt:=sbdesproteger, title:=sbtitulo, default:=””, type:=2)

if sbproteger = ok then
if sbproteger = “” then
msgbox “digite uma senha !!!”
sbproteger = application.inputbox(prompt:=sbdesproteger, title:=sbtitulo, default:=””, type:=2)
end if
else

if sbproteger = cancel then
exit sub
end if

if sbproteger = vbcancel then

msgbox “arquivo não foi protegido!!!” & vbcrlf _
, vbcritical, “wagner goularte”
exit sub
end if

for each wsplan in activeworkbook.worksheets
wsplan.protect password:=sbproteger, drawingobjects:=true, contents:=true, scenarios:=true, _
allowfiltering:=true, allowformattingcells:=true, allowformattingcolumns:=true, _
allowformattingrows:=true, allowinsertingcolumns:=true, allowinsertingrows:=true, _
allowinsertinghyperlinks:=true, allowdeletingcolumns:=true, allowdeletingrows:=true, _
allowsorting:=true, allowusingpivottables:=true

next wsplan

msgbox “arquivo protegido com sucesso!!!”

sbproteger = empty

application.screenupdating = true

end if
end sub

diz alguma coisa, ok?

fica bem!!!

[Anónimo]

bom dia jorge!

funcionou perfeitamente !!!!

mais um detalhe, a senha está aparecendo ao digitar, tem como colocar para aparecer asterisco (****)? sem precisar criar userform..

muito obrigado mais uma vez !!!!

[jorgerod]

boas, wagner,

com o inputbox normal, não é possível fazer o que pretendes.

no entanto, há a possibilidade de simular um inputbox, através de código, que parece mesmo o inputbox original. se colocares o código para onde te direccionarei de seguida, no teu código, em vez de digitares , digitarás …

o link onde o código fonte se encontra e que é mérito do mvp daniel klan, é o seguinte:

http://www.tomasvasquez.com.br/blog/microsoft-office/vba-utilizando-inputbox-com-mascara-senha

fica bem.

[Anónimo]

jorge, não funcionou. meu windows é o 64bits. segue a msg de erro:

erro de compilação:
o código desse projeto deve ser atualizado para o uso em sistema de 64bitz. analise e atualize as instruções declare e, em seguida, marque-as com o atributo ptrsafe.

você pode me ajudar com esse erro?

att.
wagner

[jorgerod]

wagner,

eu continuo a utilizar o windows 7 pro, de 32 bits e o office 2010 pro, também de 32 bits…

de qualquer modo, o pouco que vi sobre este assunto, pode ser visto, em: http://br.groups.yahoo.com/group/excelbr/message/76357

no entanto, a microsoft, deu uma resposta mais simples, que pode ser vista em:
http://support.microsoft.com/kb/983043

e em:
http://msdn.microsoft.com/en-us/library/gg251723.aspx

e em:
http://msdn.microsoft.com/en-us/library/ee691831.aspx

[Anónimo]

jorge, a parte do começo deu certo (em azul).
porem continua a aparecer a senha ao invés do asterisco (****). onde está o erro?

grato.

#if win64 then

public declare ptrsafe function callnexthookex lib “user32” (byval hhook as long, _
byval ncode as long, byval wparam as long, lparam as any) as long

public declare ptrsafe function getmodulehandle lib “kernel32” alias “getmodulehandlea” ( _
byval lpmodulename as string) as long

public declare ptrsafe function setwindowshookex lib “user32” alias “setwindowshookexa” ( _
byval idhook as long, byval lpfn as long, byval hmod as long, byval dwthreadid as long) _
as long

public declare ptrsafe function unhookwindowshookex lib “user32” (byval hhook as long) as long

public declare ptrsafe function senddlgitemmessage lib “user32” alias “senddlgitemmessagea” ( _
byval hdlg as long, byval niddlgitem as long, byval wmsg as long, byval wparam as long, _
byval lparam as long) as long

public declare ptrsafe function getclassname lib “user32” alias “getclassnamea” (byval hwnd as long, _
byval lpclassname as string, byval nmaxcount as long) as long

public declare ptrsafe function getcurrentthreadid lib “kernel32” () as long
#else

private declare function callnexthookex lib “user32” (byval hhook as long, _
byval ncode as long, byval wparam as long, lparam as any) as long

private declare function getmodulehandle lib “kernel32” alias “getmodulehandlea” ( _
byval lpmodulename as string) as long

private declare function setwindowshookex lib “user32” alias “setwindowshookexa” ( _
byval idhook as long, byval lpfn as long, byval hmod as long, byval dwthreadid as long) _
as long

private declare function unhookwindowshookex lib “user32” (byval hhook as long) as long

private declare function senddlgitemmessage lib “user32” alias “senddlgitemmessagea” ( _
byval hdlg as long, byval niddlgitem as long, byval wmsg as long, byval wparam as long, _
byval lparam as long) as long

private declare function getclassname lib “user32” alias “getclassnamea” (byval hwnd as long, _
byval lpclassname as string, byval nmaxcount as long) as long

private declare function getcurrentthreadid lib “kernel32” () as long

#end if

‘constants to be used in our api functions
private const em_setpasswordchar = &hcc
private const wh_cbt = 5
private const hcbt_activate = 5
private const hc_action = 0

private hhook as long

public function newproc(byval lngcode as long, byval wparam as long, byval lparam as long) as long

dim retval
dim strclassname as string, lngbuffer as long

if lngcode app hang!
on error goto exitproperly
lngthreadid = getcurrentthreadid
lngmodhwnd = getmodulehandle(vbnullstring)

hhook = setwindowshookex(wh_cbt, addressofnewproc, lngmodhwnd, lngthreadid)
if xpos then
inputboxdk = inputbox(prompt, title, default, xpos, ypos, helpfile, context)
else
inputboxdk = inputbox(prompt, title, default, , , helpfile, context)
end if

exitproperly:
unhookwindowshookex hhook

end function

sub teste()
msgbox inputboxdk(“digite sua senha”, “atenção”, “123456”)
end sub

[jorgerod]

boas,

acho que (sem ter verificado), ao invés da função asc(), deveria ser a função chr():

senddlgitemmessage wparam, &h1324, em_setpasswordchar, chr(42), &h0

digo isto, porque a função asc(), dá o código ascii, ou seja exactamente o contrário do que se pretende:

chr(42) dá “*”
asc(“*”) dá 42

podes experimentar. depois diz qq coisa, ok?

[Anónimo]

na verdade continua a aparecer a senha digitada e não está protegendo o arquivo.

[Anónimo]

wagner, vc pode criar um [form] com 2 campos de textos para a digitação da senha!
com isso vc pode trocar a opção de “passwordchar” e informar o caracter a ser utilizado para esconder a visualização da senha.

pode também criar uma logica para digitar a confirmação somente qdo se der o ok da primeira digitação, e também pode limitar os caracteres.

neste exemplo eu criei um form, com dois textbox e limitação de 6 caracteres sendo eles somente números…
teste_wagner.xls

[Autor]

Artigos