- Este tópico contém 20 respostas, 2 utilizadores e foi actualizado pela última vez há 10 anos, 12 meses por Anónimo.
-
AutorArtigos
-
-
27 de Março de 2013 às 14:52 #1271AnónimoInactivo
olá,
gostaria de obter ajuda no seguinte:
fazer formatação condicional associada à colocação de um comentário e de um vlookup, com vba.em anexo, envio o meu pedido de ajuda.
desde já o meu muito obrigada
elza
VBA_Ajuda.doc -
27 de Março de 2013 às 21:56 #2152jorgerodAdministrador
boas,
anexa aqui uma planilha de exemplo, para se poder trabalhar nela, ok?
fica bem.
-
28 de Março de 2013 às 11:36 #2153AnónimoInactivo
-
28 de Março de 2013 às 21:24 #2154jorgerodAdministrador
olá elza,
partindo do principio de que estamos em fase de testes, fiz, em primeiro lugar, um apontamento de código, que, no final, vai buscar um outro código elaborado pela mvp dana delouis, construindo, a final, o comentário de modo a ficar sempre totalmente visível, quer o texto seja curto ou comprido.
passando mais à prática: o código que construí, está estruturado para que seja executado quando deres um duplo clique numa das células da tua coluna d.
vais ver duas mensagens previamente ao aparecimento do comentário, mas, depois, se quiseres, podes tirá-las, como é evidente… 🙂
desde que faças alguma alteração numa das células das colunas q e/ou r, correspondentes à célula da coluna d, tens que ir a esta e dar o tal duplo clique, para que o comentário seja actualizado.
bom, experimenta e diz qq coisa, ok? quanto ao resto (formatação a cores), veremos isso a seguir, ok?
envio-te então o ficheiro com os códigos que apresento abaixo:
'---------------------------------------------------------------------------------------
' procedure : worksheet_beforedoubleclick
' author : jrod
' date : 28/03/2013
' purpose :
'---------------------------------------------------------------------------------------
'
private sub worksheet_beforedoubleclick(byval target as range, cancel as boolean)dim rcell as string
dim rcell1 as string
dim xpto as string
dim xpto1 as string
dim rng as rangeif not intersect(target, range("d:d")) is nothing then
cancel = true
set rng = activecell.offset(0, 0)rcell = activecell.offset(0, 13)
if rcell = "" then
xpto = msgbox(prompt:="falta chegar:" & chr(10) & "nada", title:="falta chegar")
else
xpto = msgbox(prompt:="falta chegar:" & chr(10) & rcell, title:="falta chegar")
end ifrcell1 = activecell.offset(0, 14)
if rcell1 = "" then
xpto1 = msgbox(prompt:="falta aprovação:" & chr(10) & chr(10) & "nada", title:="falta aprovação")
else
xpto1 = msgbox(prompt:="falta aprovação:" & chr(10) & chr(10) & rcell1, title:="falta aprovação")
end ifif rng.comment is nothing then rng.addcomment
rng.comment.text "falta chegar:" & chr(10) & rcell & chr(10) & chr(10) & "falta aprovação:" & chr(10) & chr(10) & rcell1 & chr(10) & chr(10) & format(now)
call comments_autosize
end if
end sub
sub comments_autosize()
'posted by dana delouis 2000-09-16dim mycomments as comment
dim larea as long
for each mycomments in activesheet.comments
with mycomments
.shape.textframe.autosize = true
if .shape.width > 300 then
larea = .shape.width * .shape.height
.shape.width = 200
' an adjustment factor of 1.1 seems to work ok.
.shape.height = (larea / 200) * 1.1
end if
end with
next ' comment
end sub
TesteVBA_2013-03-28-2.xlsm -
28 de Março de 2013 às 22:05 #2155AnónimoInactivo
olá jorge,
desde já obrigada.
a ideia é essa, mas o que eu pretendo é que o comentário, apareça não na folha lotes, mas na folha abr.
🙂
elza -
30 de Março de 2013 às 1:43 #2156jorgerodAdministrador
olá elza,
bom, continuando a fazer exactamente como foi dito antes, ou seja, clicar numa célula da folha lotes, agora, vai colocar o comentário na folha abr, na célula que contém o valor igual ao da célula da folha lotes.
o código, passa a ser o seguinte:
'---------------------------------------------------------------------------------------
' procedure : worksheet_beforedoubleclick
' author : jrod
' date : 28/03/2013
' purpose :
'---------------------------------------------------------------------------------------
'
private sub worksheet_beforedoubleclick(byval target as range, cancel as boolean)dim rcell as string
dim rcell1 as string
dim xpto as string
dim xpto1 as string
dim rng as range
dim vdata as longsheets(2).select
if not intersect(target, range("d:d")) is nothing then
cancel = true
vdata = activecell.valuercell = activecell.offset(0, 13)
if rcell = "" then
xpto = msgbox(prompt:="falta chegar:" & chr(10) & "nada", title:="falta chegar")
else
xpto = msgbox(prompt:="falta chegar:" & chr(10) & rcell, title:="falta chegar")
end ifrcell1 = activecell.offset(0, 14)
if rcell1 = "" then
xpto1 = msgbox(prompt:="falta aprovação:" & chr(10) & chr(10) & "nada", title:="falta aprovação")
else
xpto1 = msgbox(prompt:="falta aprovação:" & chr(10) & chr(10) & rcell1, title:="falta aprovação")
end ifwith sheets(1).range("a1:r500")
set rng = .find(what:=vdata, _
after:=.cells(.cells.count), _
lookin:=xlvalues, _
lookat:=xlwhole, _
searchorder:=xlbyrows, _
searchdirection:=xlnext, _
matchcase:=false)if rng.comment is nothing then rng.addcomment
rng.comment.text "falta chegar:" & chr(10) _
& rcell & chr(10) & chr(10) & "falta aprovação:" & chr(10) _
& chr(10) & rcell1 & chr(10) & chr(10) & format(now)end with
sheets(1).select
call comments_autosize
end if
end sub
envio, de qq modo, o novo ficheiro, com a alteração.
fica bem e diz qq coisa, ok? 🙂
-
30 de Março de 2013 às 21:12 #2158AnónimoInactivo
olá jorge,
já testei novamente o código.
detectei apenas, que se na folha abr, o n.º de lote aparecer mais do que uma vez, ele não coloca o comentário em todas as células onde ele aparece. ex. lote 3136, que aparece duas vezes, e o comentário é apenas colocado na 1.ª célula onde ele aparece.
pretende-se que a folha seja dinâmica. assim, será possível que sempre que se actualizar a folha lotes, e ao clicarmos no n.º de lote, ele apague o comentário anterior e coloque o novo?
no que respeita à formatação condicional, eu consigo sem programação, que o n.º de lote altere a cor de acordo com o pretendido, mas o ficheiro é para ser utilizado por uma equipa de trabalho e ainda não temos todos a mesma versão de excel, pelo que a formatação conditional terá de ser via programação.
obrigada uma vez mais.
elza
-
30 de Março de 2013 às 21:46 #2159jorgerodAdministrador
olá elza,
julgo que já tratei do assunto relacionado com os comentários. quanto à formatação condicional, vou tentar ver logo que tenha oportunidade.
vê o seguinte código (mando-te o ficheiro também com a alteração exemplificada na folha abr):
'---------------------------------------------------------------------------------------
' procedure : worksheet_beforedoubleclick
' author : jrod
' date : 28/03/2013
' purpose :
'---------------------------------------------------------------------------------------
'
private sub worksheet_beforedoubleclick(byval target as range, cancel as boolean)dim rcell as string
dim rcell1 as string
dim xpto as string
dim xpto1 as string
dim rng as range
dim vdata as long
dim firstaddress as stringsheets(2).select
if not intersect(target, range("d:d")) is nothing then
cancel = true
vdata = activecell.valuercell = activecell.offset(0, 13)
if rcell = "" then
xpto = msgbox(prompt:="falta chegar:" & chr(10) & "nada", title:="falta chegar")
else
xpto = msgbox(prompt:="falta chegar:" & chr(10) & rcell, title:="falta chegar")
end ifrcell1 = activecell.offset(0, 14)
if rcell1 = "" then
xpto1 = msgbox(prompt:="falta aprovação:" & chr(10) & chr(10) & "nada", title:="falta aprovação")
else
xpto1 = msgbox(prompt:="falta aprovação:" & chr(10) & chr(10) & rcell1, title:="falta aprovação")
end ifwith sheets(1).range("a1:r500")
set rng = .find(what:=vdata, _
after:=.cells(.cells.count), _
lookin:=xlvalues, _
lookat:=xlwhole, _
searchorder:=xlbyrows, _
searchdirection:=xlnext, _
matchcase:=false)if not rng is nothing then ' parte nova e acrescentada
firstaddress = rng.address ' parte nova e acrescentadado ' parte nova e acrescentada
if rng.comment is nothing then rng.addcommentrng.comment.text "falta chegar:" & chr(10) _
& rcell & chr(10) & chr(10) & "falta aprovação:" & chr(10) _
& chr(10) & rcell1 & chr(10) & chr(10) & format(now)set rng = .findnext(rng) ' parte nova e acrescentada
loop while not rng is nothing and rng.address firstaddress ' parte nova e acrescentada
end if
end withsheets(1).select
call comments_autosize
end if
end sub
-
31 de Março de 2013 às 2:51 #2160jorgerodAdministrador
olá elza (mais uma vez b) ),
abaixo, envio-te novamente o ficheiro de exemplo, desta vez com uma espécie de formatação condicional, na folha abr. como funciona: ou digitas o número que queres na célula pretendida, ou carregas em f2, activas assim a célula desejada e carregas em enter. se tudo correr bem, o código vai ler à folha lotes e procura pelo valor que está contido na tal célula da folha abr e verifica se nas células correspondentes das colunas m e n, se encontram os ok’s… conforme tenha ok–ok, verde; ok–nada, magenta; nada-nada, encarnado.
experimenta e diz qq coisa, ok?
abaixo o código e a folha:
'---------------------------------------------------------------------------------------
' procedure : worksheet_change
' author : jrod
' date : 31/03/2013
' purpose :
'---------------------------------------------------------------------------------------
'
private sub worksheet_change(byval target as range)dim rcell as string
dim rcell1 as string
dim rng as range
dim vdata as long
dim rnew as stringsheets(1).select
if not intersect(target, range("d:r")) is nothing then
cancel = true
activecell.offset(-1, 0).selectvdata = activecell.value
with sheets(2).range("d:d")
set rng = .find(what:=vdata, _
after:=.cells(.cells.count), _
lookin:=xlvalues, _
lookat:=xlwhole, _
searchorder:=xlbyrows, _
searchdirection:=xlnext, _
matchcase:=false)if not rng is nothing then
rcell = rng.offset(0, 9).address
rcell1 = rng.offset(0, 10).address
msgbox vdata & "--" & rcell & "/" & rcell1 ' mensagem apenas para controlo...
end ifend with
if sheets(2).range(rcell) = "ok" and sheets(2).range(rcell1) = "ok" then
activecell.font.color = vbgreen
elseif sheets(2).range(rcell) = "ok" and sheets(2).range(rcell1) = "" then
activecell.font.color = vbmagenta
else
activecell.font.color = vbred
end ifend if
end sub
Attachments:
You must be logged in to view attached files. -
31 de Março de 2013 às 21:26 #2161jorgerodAdministrador
olá elza,
há uma pequena nuance a ter em conta no tipo da variável vdata, no procedimento worksheet_beforedoubleclick. está como “long”, mas deverá ser como “variant”, uma vez que tu utilizas número ou texto.
fica bem.
-
1 de Abril de 2013 às 9:26 #2162AnónimoInactivo
olá bom dia,
jorge,
testei o código. o código funciona, mas só se a célula não tiver nenhum comentário. se a célula já tiver um comentário, ele não apaga o comentário existente e coloca o novo.
na formatação condicional, falta apenas colocar a bold.
agora para complicar, eu tentei adaptar o código para a minha folha de trabalho, e como tenho uma folha por cada mês de trabalho, o código por defeito seleccionava a folha jan, que é a 1.ª do ficheiro. não ía para a de abr.
como é que se aplica o código a todo o documento? na folha lotes, ao clicar no lote, ele procurava em todas as folhas o n.º de lote e colocava o comentário na respectiva célula.
obrigada
elza
-
1 de Abril de 2013 às 23:10 #2163jorgerodAdministrador
quanto ao teu primeiro parágrafo – estive a experimentar e, se alterar alguma coisa numa das células correspondentes ao número da coluna d, tens sempre que dar um duplo clique nessa célula, para que o comentário seja actualizado.
quanto ao resto, já vou ver, ok?
-
1 de Abril de 2013 às 23:27 #2164jorgerodAdministrador
elza,
duas situações (desculpa se não percebi 🙂 🙂 ): o bold é para o comentário, ou para o valor da célula da folha abr?
se for para o comentário, tens que adicionar o código que te indico, no segmento que, igualmente, assinalo:
rng.comment.shape.textframe.characters.font.bold = true
if not rng is nothing then ' parte nova e acrescentada
firstaddress = rng.address ' parte nova e acrescentadado ' parte nova e acrescentada
if not (rng.comment is nothing) then rng.comment.delete ' novo - apaga comentárioif rng.comment is nothing then rng.addcomment
rng.comment.text "falta chegar:" & chr(10) _
& rcell & chr(10) & chr(10) & "falta aprovação:" & chr(10) _
& chr(10) & rcell1 & chr(10) & chr(10) & format(now)
rng.comment.shape.textframe.characters.font.bold = true ' parte nova e acrescentada, para pôr o comentário a bold
set rng = .findnext(rng) ' parte nova e acrescentadaloop while not rng is nothing and rng.address firstaddress ' parte nova e acrescentada
end ifse for para a célula, então a linha de código no segmento que assinalo será:
activecell.font.bold = true
if sheets(2).range(rcell) = "ok" and sheets(2).range(rcell1) = "ok" then
activecell.font.color = vbgreen
activecell.font.bold = trueelseif sheets(2).range(rcell) = "ok" and sheets(2).range(rcell1) = "" then
activecell.font.color = vbmagenta
activecell.font.bold = true
else
activecell.font.color = vbred
activecell.font.bold = true
end if
-
2 de Abril de 2013 às 2:00 #2165jorgerodAdministrador
elza,
quanto à tua pergunta: “como é que se aplica o código a todo o documento? na folha lotes, ao clicar no lote, ele procurava em todas as folhas o n.º de lote e colocava o comentário na respectiva célula.”, espero que a resposta esteja no seguinte código (envio também a folha). diz qq coisa, ok?
'---------------------------------------------------------------------------------------
' procedure : worksheet_beforedoubleclick
' author : jrod
' date : 02/04/2013
' purpose :
'---------------------------------------------------------------------------------------
'
private sub worksheet_beforedoubleclick(byval target as range, cancel as boolean)dim rcell as string
dim rcell1 as string
dim xpto as string
dim xpto1 as string
dim rng as range
dim vdata as variant
dim firstaddress
dim txmes(1 to 3) as string ' novo - para os 12 meses, terá que ser 1 to 12
dim i as integertxmes(1) = "fev" ' novo - estes serão os nomes das folhas
txmes(2) = "mar" ' novo - estes serão os nomes das folhas
txmes(3) = "abr" ' novo - estes serão os nomes das folhas, etc, etc...sheets(1).select ' novo - coloquei a folha lotes, como sendo a primeira folha
if not intersect(target, range("d:d")) is nothing then
cancel = true
vdata = activecell.valuercell = activecell.offset(0, 13)
if rcell = "" then
xpto = msgbox(prompt:="falta chegar:" & chr(10) & "nada", title:="falta chegar")
else
xpto = msgbox(prompt:="falta chegar:" & chr(10) & rcell, title:="falta chegar")
end ifrcell1 = activecell.offset(0, 14)
if rcell1 = "" then
xpto1 = msgbox(prompt:="falta aprovação:" & chr(10) & chr(10) & "nada", title:="falta aprovação")
else
xpto1 = msgbox(prompt:="falta aprovação:" & chr(10) & chr(10) & rcell1, title:="falta aprovação")
end iffor i = 1 to 3 ' novo - tem a ver com o número de folhas
with worksheets(txmes(i)).range("a1:r500")
set rng = .find(what:=vdata, _
after:=.cells(.cells.count), _
lookin:=xlvalues, _
lookat:=xlwhole, _
searchorder:=xlbyrows, _
searchdirection:=xlnext, _
matchcase:=false)if not rng is nothing then ' parte nova e acrescentada
firstaddress = rng.address ' parte nova e acrescentadado ' parte nova e acrescentada
if not rng.comment is nothing then rng.comment.delete ' novo - apaga comentárioif rng.comment is nothing then rng.addcomment
rng.comment.text "falta chegar:" & chr(10) _
& rcell & chr(10) & chr(10) & "falta aprovação:" & chr(10) _
& chr(10) & rcell1 & chr(10) & chr(10) & format(now)
rng.comment.shape.textframe.characters.font.bold = true ' parte nova e acrescentada, para pôr o comentário a bold
rng.comment.shape.textframe.autosize = true ' parte nova e acrescentada, para automatizar o tamanho do comentárioset rng = .findnext(rng) ' parte nova e acrescentada
loop while not rng is nothing and rng.address firstaddress ' parte nova e acrescentada
end if
end with
next i
end ifend sub
-
2 de Abril de 2013 às 14:07 #2166AnónimoInactivo
olá jorge,
está a ser “um parto difícil” :unsure:
testei novamente, a agora aparecem-me erros. quando tento fazer a formatação condicional, aparece-me o erro 1004.
envio em anexo, uma “foto” do erro.por outro lado, quando tento gravar o ficheiro no meu pc, o código deixa de funcionar.
por vezes também, os comentários deixam de ser visíveis. vejo a película de comentário, mas se colocar o cursor por cima, não o vejo. para aceder ao comentário, tenho de fazer com o botão direito do rato: visualizar comentário.
uma vez mais obrigada!
elza
Doc1.doc -
2 de Abril de 2013 às 14:35 #2167AnónimoInactivo
jorge,
utilizei o código no meu documento de trabalho, e está a funcionar!!!
fantástico!
falta apenas “limar” a questão da formatação condicional.
muito bom! obrigada
elza
-
2 de Abril de 2013 às 21:05 #2168jorgerodAdministrador
ainda bem, elza!!!! sempre às ordens!!! 🙂
-
3 de Abril de 2013 às 14:39 #2169AnónimoInactivo
olá jorge,
falta apenas “limar umas arestas”:
quando clicamos na folha do mês no n.º de lote, ou noutra célula, que não tenha correspondência na folha de lotes aparece o erro 1004. será possível melhorar o código no sentido de se o valor não existir na folha dos lotes ele ignorar?
obrigada
elza
-
3 de Abril de 2013 às 18:24 #2170jorgerodAdministrador
olá elza,
acrescentei, para evitar o aparecimento do tal erro, a peça de código on error resume next.
no que diz respeito ao caso de se apagar o conteúdo de uma célula das folhas mensais e que contenham comentário, adicionei também um pouco de código que faz com que ao apagar e fazer enter, o comentário também desaparece.
bom, verifica, adapta e diz qq coisa, ok?
fica bem.
em anexo, a folha com os novos códigos, que contêm a data de hoje para ser mais perceptível 🙂
-
4 de Abril de 2013 às 15:48 #2171AnónimoInactivo
olá boa tarde,
jorge,
funciona!!!
isto traduziu-se numa poupança de tempo fantástica!!
muito obrigada!
elza
-
4 de Abril de 2013 às 17:55 #1272jorgerodAdministrador
ok, elza!!!! ainda bem!!!!
como disse antes, sempre “às ordens”!!!! 🙂
-
-
AutorArtigos
- Tem de iniciar sessão para responder a este tópico.