[Anónimo]

boa tarde,
necessito de uma pequena ajuda. acerca do código que está aqui disponibilizado em que faz um histórico das alterações na célula.
será possivel adaptá-lo só para 1 coluna?
mto ob

public acval
public allval ‘ adicionado

private sub worksheet_change(byval target as excel.range)
on error resume next
target.addcomment
target.comment.text “o valor anterior foi: ” & acval & _
vblf & allval ‘ modificado/adicionado
end sub

private sub worksheet_selectionchange(byval target as excel.range)
if activecell.address target.address then exit sub
if target.value = “” then
acval = “”
allval = “” ‘ adicionado
else
allval = activecell.comment.text ‘ adicionado
acval = target.value
end if
end sub

[jorgerod]

boas, francordeiro,

experimenta adaptar, a partir do seguinte código que colhi do site vba express, cujo mérito lhe está associado:

‘code to be placed in the worksheet(s) you want to use this in
option explicit
public oldrange as range

private sub worksheet_selectionchange(byval target as excel.range)
on error resume next
dim rng as range
set rng = target(1, 1)

oldrange.comment.visible = false

with rng
if not .comment is nothing then
if .comment.visible = false then
.comment.visible = true
else
.comment.visible = false
end if
end if
end with

set oldrange = target(1, 1)
end sub

private sub worksheet_beforedoubleclick(byval target as excel.range, cancel as boolean)
on error resume next
dim cmttext as string
dim inputtext as string

if target.comment is nothing then
cmttext = inputbox(“enter info:”, “comment info”)
if cmttext = “” then exit sub
target.addcomment text:=cmttext
target.comment.visible = true
target.comment.shape.textframe.autosize = true ‘remove if you want to size it yourself
else
if target.comment.text “” then
inputtext = inputbox(“enter info:”, “comment info”)
if inputtext = “” then exit sub
cmttext = target.comment.text & chr(10) & inputtext
else
cmttext = inputbox(“enter info:”, “comment info”)
end if
target.clearcomments
target.addcomment text:=cmttext
target.comment.visible = true
target.comment.shape.textframe.autosize = true ‘remove if you want to size it yourself
end if

cancel = true ‘remove this if you want to enter text in the cell after you add the comment
end sub

ao dares um duplo click na célula pretendida, adicionarás o comentário que pretendes. se deres novamente um duplo click na mesma célula, irás acrescentar um novo comentário, mantendo-se os comentários anteriores.

[Anónimo]

bom dia jorgerod,

obrigado pela resposta. esta solução não era bem a que pretendia. eu queria que a introdução do comentário fosse pela digitação na própria celula, necessito do valor para cálculo. a razão por que pretendo só numa coluna é que o resto da folha tem actualizações através de consultas “microsoft query”, e a folha actualiza toda. daí que só queira numa coluna ou depois adaptar para duas. o objectivo principal era não perder a 1ª inf. da celula. esta solução tambem é interessante.

ob

[Anónimo]

francordeiro escreveu:
bom dia jorgerod,

obrigado pela resposta. esta solução não era bem a que pretendia. eu queria que a introdução do comentário fosse pela digitação na própria celula, necessito do valor para cálculo. a razão por que pretendo só numa coluna é que o resto da folha tem actualizações através de consultas “microsoft query”, e a folha actualiza toda. daí que só queira numa coluna ou depois adaptar para duas. o objectivo principal era não perder a 1ª inf. da celula. esta solução tambem é interessante.

ob

compilei este codigo, que aparentemente está a funcionar.

public acval
public allval ‘ adicionado

private sub worksheet_change(byval target as excel.range)

on error resume next

dim wks as worksheet, cmt as comment

for each wks in worksheets
for each cmt in wks.comments
cmt.shape.oleformat.object.autosize = true
with cmt.shape.oleformat.object.font
.name = “tahoma”
.size = 7
.colorindex = 2
end with
cmt.shape.oleformat.object.shaperange.fill.forecolor.schemecolor = 29
next cmt
next wks

if (application.intersect(target, range(“l1:l150”)) is nothing) then
range(“a1”).select
else
target.addcomment
target.comment.text “o valor anterior foi: ” & acval & _
vblf & allval ‘ modificado/adicionado

end if
end sub

private sub worksheet_selectionchange(byval target as excel.range)

on error goto erro
with application
.screenuddating = false
end with

if activecell.address target.address then exit sub
if target.value = “” then
acval = “”
allval = “” ‘ adicionado
else
on error resume next
allval = activecell.comment.text ‘ adicionado
acval = target.value
end if

erro:
with application
.screenupdating = true
end with
end sub

se estiver ok, espero que possa ser util para mais alguem, e assim desta forma poder contribuir para enriquecer mais um pouco este forum.

mto ob

[Anónimo]

francordeiro escreveu:
francordeiro escreveu:
bom dia jorgerod,

obrigado pela resposta. esta solução não era bem a que pretendia. eu queria que a introdução do comentário fosse pela digitação na própria celula, necessito do valor para cálculo. a razão por que pretendo só numa coluna é que o resto da folha tem actualizações através de consultas “microsoft query”, e a folha actualiza toda. daí que só queira numa coluna ou depois adaptar para duas. o objectivo principal era não perder a 1ª inf. da celula. esta solução tambem é interessante.

ob

compilei este codigo, que aparentemente está a funcionar.

public acval
public allval ‘ adicionado

private sub worksheet_change(byval target as excel.range)

on error resume next

dim wks as worksheet, cmt as comment

for each wks in worksheets
for each cmt in wks.comments
cmt.shape.oleformat.object.autosize = true
with cmt.shape.oleformat.object.font
.name = “tahoma”
.size = 7
.colorindex = 2
end with
cmt.shape.oleformat.object.shaperange.fill.forecolor.schemecolor = 29
next cmt
next wks

if (application.intersect(target, range(“l1:l150”)) is nothing) then
range(“a1”).select
else
target.addcomment
target.comment.text “o valor anterior foi: ” & acval & _
vblf & allval ‘ modificado/adicionado

end if
end sub

private sub worksheet_selectionchange(byval target as excel.range)

‘on error goto erro
‘ with application
‘ .screenuddating = false
‘end with

if activecell.address target.address then exit sub
if target.value = “” then
acval = “”
allval = “” ‘ adicionado
else
on error resume next
allval = activecell.comment.text ‘ adicionado
acval = target.value
end if

‘erro:
‘with application
‘ .screenupdating = true
‘end with
end sub

se estiver ok, espero que possa ser util para mais alguem, e assim desta forma poder contribuir para enriquecer mais um pouco este forum.

mto ob

[jorgerod]

É sempre óptima a partilha de informação, porque nos ajuda a criar condições de solução para os nossos problemas e há sempre partes de código que podem ser aproveitadas para outro tipo de soluções.

obrigado em nome do forum do exceler! 🙂

[Autor]

Artigos