excel vba - Applying code to colored cells only in VBA excell -
i trying adapt code found of our recipe sheets take scanned entries instead of typed. cell require input colored orange. these cells accept scanned entries. far have apply code column "i" , colors orange. not color cells use colored cells. heres have far
..
option explicit declare function setwindowshookex lib _ "user32" alias "setwindowshookexa" (byval idhook long, byval lpfn long, _ byval hmod long, byval dwthreadid long) long declare function callnexthookex lib "user32" _ (byval hhook long, byval ncode long, byval wparam long, lparam any) long declare function unhookwindowshookex lib "user32" (byval hhook long) long declare function getactivewindow lib "user32" () long declare function findwindow lib "user32" alias "findwindowa" _ (byval lpclassname string, byval lpwindowname string) long const hc_action = 0 const wm_keydown = &h100 const wh_keyboard_ll = 13 dim hhklowlevelkybd long dim blnhookenabled boolean dim enumallowedvalues allowedvalues dim objtargetrange range dim objvalidationrange range dim vans variant type kbdllhookstruct vkcode long scancode long flags long time long dwextrainfo long end type enum allowedvalues alpha numeric end enum function lowlevelkeyboardproc _ (byval ncode long, byval wparam long, lparam kbdllhookstruct) long '\hook keyboard if xl active window if getactivewindow = findwindow("xlmain", application.caption) if (ncode = hc_action) '\check if key pushed if wparam = wm_keydown '\if so, check if active cell within target range if union(activecell, objtargetrange).address = objtargetrange.address '\if numeric values should allowed if enumallowedvalues = 1 '\check if pushed key numeric key or navigation key '\by checking vkcode stored in laparm parameter if chr(lparam.vkcode) "#" or _ lparam.vkcode = 37 or lparam.vkcode = 38 or lparam.vkcode = 39 or _ lparam.vkcode = 40 or lparam.vkcode = 9 or lparam.vkcode = 13 '\if allow input lowlevelkeyboardproc = 0 else '\else filter out key_down message message qeue beep lowlevelkeyboardproc = -1 exit function end if '\if onle alpha values should allowed elseif enumallowedvalues = 0 '\check laparam parameter if chr(lparam.vkcode) "#" '\if numeric prevent input beep lowlevelkeyboardproc = -1 exit function else '\otherwise allow input lowlevelkeyboardproc = 0 end if end if end if end if end if end if '\pass function next hook if there 1 lowlevelkeyboardproc = callnexthookex(0, ncode, wparam, byval lparam) end function public sub unhook_keyboard() if hhklowlevelkybd <> 0 unhookwindowshookex hhklowlevelkybd blnhookenabled = false end sub sub validaterange(r range, byval v allowedvalues) '\store these in global variables '\needed later in filter function enumallowedvalues = v set objtargetrange = r '\don't hook keyboard twice !! if blnhookenabled = false hhklowlevelkybd = setwindowshookex _ (wh_keyboard_ll, addressof lowlevelkeyboardproc, application.hinstance, 0) blnhookenabled = true end if end sub sub test() '\ignore mishandling of following '\input boxes user on error resume next set objvalidationrange = sheets("sheet1").range("i:i") if objvalidationrange nothing goto errhdlr objvalidationrange.interior.colorindex = 44 vans = 2 if vans = 2 validaterange objvalidationrange, allowedvalues.numeric + alpha else goto errhdlr end if objvalidationrange.cells(1).select set objvalidationrange = nothing exit sub errhdlr: msgbox "criteria error- try again !", vbcritical unhook_keyboard end sub
if you're sure cells/rows wish modify indeed characterized
.interior.colorindex = 44 then have make check , continue logic if comes out positive:
if mycell.interior.colorindex = 44 ' stuff end if in case color other simple colorindex = 44, can check in immediate window using
?mycell.interior.color you can copy color value (it's output numeric value) , paste in condition, remember differentiate between color , colorindex.
Comments
Post a Comment