Excel VBA: Activecell Range vergelijken met ander Range

[Ghost Rider]

Hallo,

Ik ben bezig met een VBA projectje in Excel 2002. De bedoeling is om te kijken of de actieve cel binnen een vooraf gestelde range valt. Zo ja, dan is er een button beschikbaar, zo nee dan moet de button geblokkeerd worden.

Ik heb al veel geprobeerd, maar ik krijg het niet voor elkaar om de actieve cel (bv B3) te vergelijken met de vooraf gestelde range


Ik hoop dat jullie kunnen helpen

[Lustucru]

iets als

code:

myButton.visible= not  (intersect(activeCell;myRange) is Nothing)

[BtM909]

of ipv .visible .enabled

[Ghost Rider]

Bedankt voor de snelle reacties, echter ik krijg het nog niet werkend. Kan iemand het volledige scriptje uitwerken met Range B1 tot J20.


Bij voorbaat dank

[F_J_K]

Nee. Daar is GoT niet voor. Doe even zelf wat pogingen op basis van de tips plus de help en geef ons het resultaat om over mee te denken. GoT is geen helpesk

[Ghost Rider]

Ik heb een iets andere code gevonden. Het werkt echter niet. Kan iemand mij vertellen wat ik hier fout doe?

De foutmelding is als volgt: Runtime error 1004. Application-defined or object required.


Sub test()

Dim isect As Range

Worksheets("Sheet1").Activate
Set isect = Application.Intersect(Range(ActiveCell), Range(B1, J20))
If isect Is Nothing Then
MsgBox "Selecteer juiste cel"
Else
Call Script
End If

End Sub

[F_J_K]

offtopic:
Wat je fout doet is een script copypasten zonder te begrijpen wat het (of VBA in het algemeen) precies doet en dan nog niet eens de tips mee te nemen die al in dit topic staan Ram op de verschillende relevante keywords op F1, lees wat er staat en je bent er echt al. Hoe dan ook moet je altijd weten wat het doet voor je een stukje code wilt gebruiken dat je ergens vandaan hebt geplukt.

Dit is uitgebreider opgeschreven dan wat mijn twee collega's zeiden, maar het doet minder. Combineer dus hun tips en je bent er. Nu copypaste je een stukje code die het echte werk in een aparte sub Script verwacht.

[Ghost Rider]

Laat ik het even anders formuleren:

Ik heb het volgende script:

code:

Option Explicit

Dim F As Variant

Sub openpdf()
  
  Dim dbRetValue As Double
  Dim stAdobeExe As String, stFileName As String
     For Each F In Application.FileSearch.FoundFiles
   stAdobeExe = "C:\Program Files\Adobe\Acrobat 7.0\Reader\AcroRd32.exe"
   stFileName = F
   dbRetValue = Shell(stAdobeExe & " " & stFileName, vbMaximizedFocus)
     Next F
   
End Sub

Sub openpdf2()

 Dim i As Single
 
For i = 1 To Application.FileSearch.FoundFiles.Count
Revisie.ListBox1.AddItem Dir(Application.FileSearch.FoundFiles(i))
Next i

Revisie.Show

End Sub

Sub Search_files()

 Dim A As String
 Dim FileS As FileSearch
 Dim dbRetValue As Double
 Dim stAdobeExe As String, stFileName As String
 Dim X As Variant

 A = ActiveCell.Value
 
 If A = "" Then MsgBox ("Selecteer Tekeningnummer")
 If A = "" Then Exit Sub

 Set FileS = Application.FileSearch
   With FileS
    .NewSearch
    .LookIn = "T:\PROE-PDF\"
    .SearchSubFolders = True
    .Filename = A & "*.pdf"
    .MatchTextExactly = True
    .Execute

End With

   If Application.FileSearch.FoundFiles.Count = 0 Then MsgBox ("Geen PDF in database")
   If Application.FileSearch.FoundFiles.Count = 0 Then Exit Sub
   If Application.FileSearch.FoundFiles.Count = 1 Then Call openpdf Else: Call openpdf2

End Sub

Werking is als volgt. Ik selecteer een cel in Excel. Vervolgens klik ik op de button en wordt sub search_files gestart. Deze bekijkt de cel waarde en gaat op zoek in de database of er een pdf bestand te vinden is. Vindt ie niks dan krijg je een msgbox, krijg je 1 dan wordt de pdf geopend, krijg je meer opties dan krijg je een listbox waaruit je een pdf kunt kiezen. Met een dubbelklik kun je vervolgens deze openen


Wat ik nu dus wil, is dat de button alleen maar functioneert als de actieve cell zich in een bepaald bereik bevindt.

Met de eerdere genoemde oplossingen krijg ik het niet voor elkaar. Ik vraag mij ook af hoe ik de button moet invoegen. Via de werkbalk userform in excel, of via userform in de VBA Editor?


Het verwijt dat ik er niets van begrijp vind ik een beetje uit de lucht gegrepen. Ik ben inderdaad geen ster in het programeren, maar ik kan me er redelijk mee redden. Ik loop alleen vast op dit stukje, dan is het klaar.

[ Voor 1% gewijzigd door F_J_K op 27-02-2007 08:59 ]

[F_J_K]

offtopic:
Ik heb even [code] tags om je code heen gezet zodat het leesbaar is. Hoe dan ook wil je eens hoed op je indenting (inspringen) letten om de structuur van je code begrijpelijk te maken en houden

Maar je hebt (een deel van) je antwoord al lang. Je roept een sub 'script' aan die niet bestaat... Maak die aan en je bent wat verder. Maar dit is helemaal niet nodig. Ik heb het even getest met een knop zoals gemaakt via de werkset besturingselementen en de ene regel van Lustucru doet het prima met een script die niets anders doet dan 'MyButton.Visible = Not (Intersect(ActiveCell, Range("B1:J20")) Is Nothing)'. (En zorg natuurlijk dat je Sheet1 ook Sheet1 heet en je knop MyButton).

[Ghost Rider]

Ik heb het nu enigszins anders opgelost, ben er zo ook tevreden mee:

code:

Sub Bereik()
    If Intersect(ActiveCell, Range("B2:J10000")) Is Nothing Then
        MsgBox "Selecteer een tekeningnummer"
    Else
        Call Search_files
    End If
End Sub

In ider geval bedankt voor jullie hulp

[F_J_K]

Inderdaad werkt dat ook prima