• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Gezochte cel laten oplichten door achtergrond van kleur te laten veranderen

Status
Niet open voor verdere reacties.
K

Kens62

Gebruiker
Lid geworden
20 jul 2017
Berichten
13
Beste mensen,

Ik heb een groot Excel bestand dat ik gebruik als plattegrond en waarin veel data en plaatjes staan.
Het programma heb ik op 50% staan.

Als ik met "CTRL + F" iets zoek dan is niet altijd direct zichtbaar waar de gezochte cel zich op het scherm bevindt.

Mijn vraag is hoe ik, bijvoorbeeld door een macro, de achtergrond van de gezocht cel op kan laten lichten.

Wie kan mij helpen.

Alvast bedankt voor de moeite.
 
bv.
Code: 
Sub hsv()
Dim ip
ip = InputBox("zoek")
 If ip <> "" Then
   Set ip = Cells.Find(ip, , , xlWhole)
  If Not ip Is Nothing Then Application.Goto ip, True
 End If
End Sub

....anders moet je nog zoeken naar die gekleurde cel, maar ook weer op xlnone zetten.
 
Laatst bewerkt:
Hartelijk dank voor de reactie. Ik ben nu weer een stukje verder.

Mijn vervolgvragen zijn nu:
- hoe kan ik er nu voor zorgen dat de gevonden cel niet linksboven in het scherm verschijnt maar in het midden van mijn beeldscherm?
- hoe kan ik er nu voor zorgen dat de gevonden cel een andere achtergrondkleur krijgt en/of een andere kleur rand krijgt?

Alvast bedankt voor de moeite.
 
Lijkt me nogal moeilijk verhaal, want alleen het oplichten met een kleurtje zou betekenen iets als Voorwaardelijk opmaak of een Worksheet_SelectionChange event, maar de kleur moet daarna weer ongedaan gemaakt worden.
Is het niet genoeg om gewoon de cel te centreren en je ziet dan vanzelf wel de zwarte rand er omheen (bovendien midden op je scherm ook nog)?

Voor het laatste heb ik de volgende code in elkaar geknutseld, gebruik makend ook van wat hsv al geprogrammeerd had en wat ik vond op Internet:
Code: 
Sub hsv()
Dim ip
ip = InputBox("zoek")
 If ip <> "" Then
   Set ip = Cells.Find(ip, , , xlWhole)
  If Not ip Is Nothing Then Application.Goto ip, True
  CenterOnCell ActiveCell
 End If
End Sub

Sub CenterOnCell(OnCell As Range)

Dim VisRows As Integer
Dim VisCols As Integer

Application.ScreenUpdating = False
'
' Switch over to the OnCell's workbook and worksheet.
'
OnCell.Parent.Parent.Activate
OnCell.Parent.Activate
'
' Get the number of visible rows and columns for the active window.
'
With ActiveWindow.VisibleRange
    VisRows = .Rows.Count
    VisCols = .Columns.Count
End With
'
' Now, determine what cell we need to GOTO. The GOTO method will
' place that cell reference in the upper left corner of the screen,
' so that reference needs to be VisRows/2 above and VisCols/2 columns
' to the left of the cell we want to center on. Use the MAX function
' to ensure we're not trying to GOTO a cell in row <=0 or column <=0.
'
With Application
    .Goto reference:=OnCell.Parent.Cells( _
        .WorksheetFunction.Max(1, OnCell.Row + _
        (OnCell.Rows.Count / 2) - (VisRows / 2)), _
        .WorksheetFunction.Max(1, OnCell.Column + _
        (OnCell.Columns.Count / 2) - _
        .WorksheetFunction.RoundDown((VisCols / 2), 0))), _
     scroll:=True
End With

OnCell.Select
Application.ScreenUpdating = True

End Sub

Tijs.
 
Laatst bewerkt:
Mocht je (zoals ik gedaan heb) een knop hebben gemaakt op het werkblad voor de uitvoering van de code van hsv én je zou willen dat die 'meevliegt' (dus een vaste positie op je scherm heeft, zodat je 'm altijd kunt klikken), dan moet je een ActiveX knop toevoegen, met daaraan gekoppeld de inhoud van de hsv module en verder een Worksheet_SelectionChange event toevoegen.
Dus bij mij hangt daaraan (mijn ActiveX knop kreeg (automatisch) de naam CommandButton1):
Code: 
Private Sub CommandButton1_Click()
[B]Dim ip
ip = InputBox("zoek")
 If ip <> "" Then
   Set ip = Cells.Find(ip, , , xlWhole)
  If Not ip Is Nothing Then Application.Goto ip, True
  CenterOnCell ActiveCell
 End If
[/B]End Sub
en de Worksheet_SelectionChange event (pas, naar smaak, de waarden 100 en 300 aan en natuurlijk CommandButton1, als die bij jou een andere naam heeft):
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
        On Error GoTo 0
        With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            CommandButton1.Top = .Top + 100
            CommandButton1.Left = .Left + 300
        End With
End Sub

Uiteraard alle codes (incl. die van mijn vorige posting) hangen aan het werkblad waar het om gaat, dus niet op het hele werkboek van toepassing verklaren.

Tijs.
 
Laatst bewerkt:
Of deze met voorwaardelijke opmaak.
Werkt ook met gedeeltelijke overeenkomst.
 

Bijlagen

  • cel oplichten.xlsm
    11,4 KB · Weergaven: 94
Ik ben tot onderstaande oplossing gekomen:

Sub LRH()
'
' LRH Macro
'
' Sneltoets: Ctrl+Shift+H
'
Sheets("LRH").Select
Range("A1").Select

Dim ip
ip = InputBox("zoek")
If ip <> "" Then
Set ip = Cells.Find(ip, , , xlWhole)
If Not ip Is Nothing Then Application.Goto ip, True
CenterOnCell ActiveCell
End If
End Sub

Sub CenterOnCell(OnCell As Range)

Dim VisRows As Integer
Dim VisCols As Integer

Application.ScreenUpdating = False

OnCell.Parent.Parent.Activate
OnCell.Parent.Activate

With ActiveWindow.VisibleRange
VisRows = .Rows.Count
VisCols = .Columns.Count
End With

With Application
.Goto reference:=OnCell.Parent.Cells( _
.WorksheetFunction.Max(1, OnCell.Row + _
(OnCell.Rows.Count / 2) - (VisRows / 2)), _
.WorksheetFunction.Max(1, OnCell.Column + _
(OnCell.Columns.Count / 2) - _
.WorksheetFunction.RoundDown((VisCols / 2), 0))), _
scroll:=True
End With

OnCell.Select
Application.ScreenUpdating = True

ActiveCell.Interior.ColorIndex = 7
Application.Wait (Now + TimeValue("0:00:02"))
ActiveCell.Interior.ColorIndex = 2
Application.Wait (Now + TimeValue("0:00:01"))
ActiveCell.Interior.ColorIndex = 4
Application.Wait (Now + TimeValue("0:00:02"))
ActiveCell.Interior.ColorIndex = 2
Application.Wait (Now + TimeValue("0:00:01"))
ActiveCell.Interior.ColorIndex = 5
Application.Wait (Now + TimeValue("0:00:02"))
ActiveCell.Interior.ColorIndex = 2
Application.Wait (Now + TimeValue("0:00:01"))
ActiveCell.Interior.ColorIndex = 6
Application.Wait (Now + TimeValue("0:00:02"))


End Sub


Iedereen bedankt voor de hulp.
De eindgebruikers zijn er blij mee.
Mocht iemand nog verbeteringen hebben dan lees ik deze graag.
 
De eerste verbetering is de code tussen codetags plaatsen. Ik kan mij niet voorstellen dat een gebruiker er blij van wordt dat er eerst 11 seconden naar een van kleur veranderende cel gekeken moet worden.
Alles in 1 procedure lijk ook te werken.
Code: 
Sub VenA()
  Dim ip, f As Range
  ip = InputBox("zoek")
  If ip <> "" Then
    Set f = Sheets("LRH").Cells.Find(ip, , , xlWhole)
    If Not f Is Nothing Then
      With Application
        .Goto f.Parent.Cells(.Max(1, f.Row - .RoundDown(ActiveWindow.VisibleRange.Rows.Count / 2, 0)), .Max(1, f.Column - .RoundDown(ActiveWindow.VisibleRange.Columns.Count / 2, 0))), True
        .Goto f
      End With
    End If
  End If
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan