macro werkt in excel 2003 maar niet meer in excel 2010

[bjornesto]

ik heb een macro code en deze werkt niet meer

in excel 2003 nog wel maar eens in excel 2010 niet meer heb de opties van excel 2010 ook aangepast.
Hij doet gewoon niets

Macro moet gewoon text dat in textbox staat in vet en onderlijnen en groter zetten

Tweede knop moet dat ongedaan maken

Private Sub CommandButton1_Click()
Dim Findwhat As String, tb As TextBox
  On Error Resume Next
  Findwhat = InputBox("Find what?")
  If Findwhat = "" Then Exit Sub
  For Each tb In ActiveSheet.TextBoxes
      l = InStr(tb.Characters.Text, Findwhat)
      If l > 0 Then
         With tb.Characters(Start:=l, Length:=Len(Findwhat)).Font
         .Name = "Arial"
         .Size = 10
         .Underline = True
         .Bold = True
         End With
      End If
  Next
End Sub

Private Sub CommandButton2_Click()
Dim Findwhat As String
  On Error Resume Next
  For Each tb In ActiveSheet.TextBoxes
         With tb.Characters.Font
         .Name = "Arial"
          .Size = 8
         .Underline = False
         .Bold = False
         End With
  Next
End Sub

 

[edmoor]

Die On Error Resume Next zorgt ervoor dat je totaal geen eventuele foutmeldingen krijgt te zien.
Haal die er dus eens uit.
Het is sowieso beter om een fout gewoon netjes af te handelen.
Nu zeg je eigenlijk dat welke fout zich ook voordoet, trek je er niks van aan en ga gewoon door.
Makkelijk, maar zeker niet handig.

 

[bjornesto]

Heb het is geprobeerd maar werkt nog niet

Ga er een bestandje bij voegen met knoppen en al

Bekijk bijlage test.xlsm

 

[edmoor]

Ik zeg ook niet dat het dan wel werkt maar dan kun je wel uitvinden waar het fout gaat.
Draai het script in debug mode.

 

[Cobbe]

Naar wat zoek je precies? Ik denk dat er niets gevonden wordt.
Als je een getal zoekt en je input is een tekst zal het niet lukken.
Kan je niet een voorbeeldje posten?

 

[snb]

Draai deze macro eens:

Sub M_snb()
   MsgBox "aantal tekstvakken: " & ActiveSheet.TextBoxes.Count
End Sub

 

[HSV]

Zo gaat het vast beter.

Private Sub CommandButton1_Click()
Dim Findwhat As String, tb As Shape, a
Findwhat = InputBox("Find what?")
 If Findwhat = "" Then Exit Sub
  For Each tb In ActiveSheet.Shapes
 If tb.AutoShapeType = msoShapeRectangle Then
    If InStr(1, tb.TextFrame.Characters.Text, Findwhat) > 0 Then
         With tb.TextFrame.Characters(Start:=l, Length:=Len(Findwhat)).Font
         .Name = "Arial"
         .Size = 10
         .Underline = xlUnderlineStyleSingle
         .Bold = True
         End With
       End If
      End If
    Next
End Sub
Private Sub CommandButton2_Click()
Dim Findwhat As String
  For Each tb In ActiveSheet.Shapes
   If tb.AutoShapeType = msoShapeRectangle Then
         With tb.TextFrame.Characters.Font
           .Name = "Arial"
           .Size = 8
           .Underline = xlUnderlineStyleNone
           .Bold = False
         End With
      End If
    Next
End Sub

 

[bjornesto]

heb het getest maar zit een fout in

hij zegt

runtime error '438'

Object doesn't support this property or method



De bedoeling is gewoon dat ze vlug kunnen kijken waar die melder zich bevind op dat plan.
Daarmee dat hij die 'textbox' moet veranderen van lettertype

Eens dat in orde is moet die terug op normaal komen te staan aan de hand van tweede knop meer niet

 

[bjornesto]

HSV

fout zit bij eerste deel

If InStr(1, tb.TextFrame.Characters.Text, Findwhat) > 0 Then

Heb die andere code ook ingevoerd en zegt dat er 0 textboxen zijn

 

[HSV]

Helaas heb ik geen Excel 2010, dus kan het niet testen.
Dit werkt in ieder geval in Excel 2007.

 

[bjornesto]

Beste HSV

Nu werkt het wel ja hier hadden ze vroeger excel 2003 en nu 2010 op excel 2010

 

[bjornesto]

HSV

ik denk dat ik weet waar het probleem zich bevind

het is niet de texboxen, maar eerder de plattegrond die staat ingesteld als helemaal achteraan
(met invoegen foto)

Want als ik dat zoek via jou bestand zonder de plattegrond erachter dan voert hij ze wel uit.

 

[HSV]

Mooi dat het werkt.

Helaas zie ik die plattegrond niet.

 

[bjornesto]

ff een bestandje bijvoegen gaat gemakkelijker met achtergrond foto

Dan zal je zien dat het niet werkt als je de foto knipt en plakt en je zoekt dan op zoeken dan werkt die code wel

Bekijk bijlage shapes textboxes.zip

 

[HSV]

Helaas krijg ik je Zip niet open.

 

[bjornesto]

HSV ik heb het geprobeerd om het door te sturen maar gaat niet is te groot dan het bestand.

maar als je gewoon een afbeelding neemt en via invoegen afbeelding en je zet het dan op de achtergrond. Dan zal hij die foutmelding geven.

spijtig dat ik het anders niet kan doorsturen het bestand is te groot anders



maar als je dat zal invoegen dan dal je zien wat ik bedoel

 

[HSV]

Voorgrond, achtergrond, beide een foutmelding; de afbeelding bevat geen textframe nl.

Ik vermoed dat het Id.nr. van een afbeelding lager ligt dan 1000, dus probeer dit eens.

Private Sub CommandButton1_Click()
Dim Findwhat As String, tb As Shape
Findwhat = InputBox("Find what?")
 If Findwhat = "" Then Exit Sub
  For Each tb In ActiveSheet.Shapes
 If tb.AutoShapeType = msoShapeRectangle And tb.ID > 1000 Then
    If InStr(1, tb.TextFrame.Characters.Text, Findwhat) > 0 Then
         With tb.TextFrame.Characters(Start:=l, Length:=Len(Findwhat)).Font
         .Name = "Arial"
         .Size = 10
         .Underline = xlUnderlineStyleSingle
         .Bold = True
         End With
       End If
      End If
    Next
End Sub
Private Sub CommandButton2_Click()
Dim Findwhat As String
  For Each tb In ActiveSheet.Shapes
   If tb.AutoShapeType = msoShapeRectangle And tb.ID > 1000 Then
         With tb.TextFrame.Characters.Font
           .Name = "Arial"
           .Size = 8
           .Underline = xlUnderlineStyleNone
           .Bold = False
         End With
      End If
    Next
End Sub

 

[bjornesto]

heb er ook nog objecten in staan (kleine afbeelding van een rookmelder en een brand drukknop)

Blijkbaar struikelt hij daar ook nog over.

 

[HSV]

Probeer nog eens te zippen of te rarren.

 

[bjornesto]

zal het zo moeten doen vrees ik

Bekijk bijlage drukknop & melder.xlsm

melder (wit object komt boven het zwarte of rode cijfer)

drukknop (rood zwart boven blauwe cijfer)