• 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.

2 niet werkende macro's

Status
Niet open voor verdere reacties.

stageloper

Gebruiker
Lid geworden
25 mei 2011
Berichten
10
Beste forum gebruiker,

Ik zit al een paar dagen te stoeien met verschillende macro's in excel en al best wat hulp gehad en ook hier en paar goed werkende macro's gekregen (daarvoor, mijn dank is groot!)

Nu heb ik echter nog 2 macro's die ik niet werkend krijg.
Hier komt de eerste, over het invoeren van 'data' in inputbox en daaruit in excel komt.
(het eerste deel heb ik zelf getypt, het tweede deel gekoppiëerd uit een deel waar ik met record functie van macro's heb gewerkt)
------------------------------------------------------------------------------------

Sub Nieuw_persoon_toevoegen()
Achternaam = InputBox("Wat is uw Achternaam?")
Voorletters = InputBox("Wat zijn uw Voorletters?")
MsgBox ("Welkom bij ABC meneer/mevrouw ") & Voorletters & Achternaam
Functie = InputBox("Wat is uw functie?")
Afdeling = InputBox("Bij welke afdeling zal u werken?")
Sleutel = InputBox("Welke nummer sleutel heeft u nodig?")
Handtekening = InputBox("Heeft u uw handtekening al gezet voor ontvangst van de sleutel? Waar/Onwaar")
Datum = InputBox("Welke datum is het vandaag?")

MsgBox ("Kloppen de volgende gegevens?" & vbCrLf & "Achternaam: " & Achternaam & vbCrLf & "Voorletters: " & Voorletters & vbCrLf & "Functie: " & Functie & vbCrLf & "Afdeling: " & Afdeling & vbCrLf & "Sleutel: " & Sleutel & vbCrLf & "Handtekening: " & Handtekening & vbCrLf & "Datum: " & Datum), vbYesNo
If Response = vbYes Then

Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A3").Select
ActiveCell.FormulaR1C1 = Achternaam
Range("B3").Select
ActiveCell.FormulaR1C1 = Voorletters
Range("C3").Select
ActiveCell.FormulaR1C1 = Functie
Range("D3").Select
ActiveCell.FormulaR1C1 = Afdeling
Range("G3").Select
ActiveCell.FormulaR1C1 = Sleutel
Range("H3").Select
ActiveCell.FormulaR1C1 = Datum
Range("I3").Select
ActiveCell.FormulaR1C1 = "P"
Range("A3").Select

End If

If Response = vbNo Then

MsgBox "De gegevens zijn incorrect. Voer de gegevens opnieuw in"

End If


End Sub
-------------------------------------------------------------------------


Waarschijnlijk kan hij veeel korter, maar ik ben nogal omslagtig en onervaring in dit soort werk en ik heb hem werken op het laatste deel na. Bij de controle vraag Yes/No maakt het niet uit waar je op klikt, altijd komt: "De gegevens zijn incorrect. Voer de gegevens opnieuw in"



De tweede macro is over de instellingen van één kolom. Door middel van het dubbelklikken op een cel in de kolom zou er een vinkje komen. ( lettertype: Wingdings 2, letter P)

In een bijlage wat ik hier ontvangen heb is die werkend, wanneer ik deze naar het grote bestand koppiëer echter niet. Heeft iemand een idee wat er verkeert gaat? Hieronder de 2de macro.


http://www.helpmij.nl/forum/showthread.php/629921-Hoe-opmaak-behouden-filter-gt-selectievakje
------------------------------------------------------------------------------

Sub Kolom_I()
Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("I2:I1000")) Is Nothing Then
If Target.Value = "" Then
With ActiveCell
.Value = "P"
.Font.Name = "Wingdings 2"
End With
Target.Offset(1, 0).Select
Else




With Target
ActiveCell.Value = ""
.Font.Name = "calibri"

End With

Target.Offset(1, 0).Select
End If
End If
End Sub

-------------------------------------------------------------------------


Alvast dank voor degene die dit lange vraagstuk alleen al gelezen hebben, en grote dank aan degene die mij kan helpen
 

Bijlagen

Macro 1
Response is altijd leeg omdat je response nergens invult!
Zo kan het wel.

Code:
Response = MsgBox("Kloppen de volgende gegevens?" & vbCrLf & "Achternaam: " & achternaam & vbCrLf & "Voorletters: " & voorletters & vbCrLf & "Functie: " & functie & vbCrLf & "Afdeling: " & afdeling & vbCrLf & "Sleutel: " & sleutel & vbCrLf & "Handtekening: " & handtekening & vbCrLf & "Datum: " & datum, vbYesNo)

Zelf zou ik geen gebruik maken van inputboxen maar een formulier gebruiken die men kan invullen.

Macro 2
Dit gaat niet werken:
Code:
Sub Kolom_I()
Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Het beste is om Kolom_I te verwijderen omdat je de code wilt starten bij het dubbelklikken op een cel.
Dus:
Code:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
)

Met vriendelijke groet,


Roncancio
 
Roncancio bedankt voor de snelle reactie!

Ik heb het gedeelte van macro 1 overgenomen, echter zonder enkele respons
Ook het gedeelte dat er een nieuwe rij toegevoegd wordt in het bestand, en dat de inputbox data ingevult wordt in deze rij wil niet, is daar een optie voor om dat te voor elkaar te krijgen?

----------------------------------------------------------------------
Sub Nieuw_persoon_toevoegen()
achternaam = InputBox("Wat is uw Achternaam?")
voorletters = InputBox("Wat zijn uw Voorletters?")
MsgBox ("Welkom bij ABC meneer/mevrouw ") & voorletters & achternaam
functie = InputBox("Wat is uw functie?")
afdeling = InputBox("Bij welke afdeling zal u werken?")
sleutel = InputBox("Welke nummer sleutel heeft u nodig?")
handtekening = InputBox("Heeft u uw handtekening al gezet voor ontvangst van de sleutel? Waar/Onwaar")
datum = InputBox("Welke datum is het vandaag?")

MsgBox ("Kloppen de volgende gegevens?" & vbCrLf & "Achternaam: " & achternaam & vbCrLf & "Voorletters: " & voorletters & vbCrLf & "Functie: " & functie & vbCrLf & "Afdeling: " & afdeling & vbCrLf & "Sleutel: " & sleutel & vbCrLf & "Handtekening: " & handtekening & vbCrLf & "Datum: " & datum), vbYesNo
If Response = vbYes Then

Response = MsgBox("Kloppen de volgende gegevens?" & vbCrLf & "Achternaam: " & achternaam & vbCrLf & "Voorletters: " & voorletters & vbCrLf & "Functie: " & functie & vbCrLf & "Afdeling: " & afdeling & vbCrLf & "Sleutel: " & sleutel & vbCrLf & "Handtekening: " & handtekening & vbCrLf & "Datum: " & datum, vbYesNo)


End If

If Response = vbNo Then

Response = MsgBox ("De gegevens zijn incorrect. Voor de gegevens opnieuw in"

End If

End Sub




------------------------------------------------------------------------


Een formulier maken heb ik ook aan gedacht alleen dat leek me toch moeilijker om te realiseren in excel voor mij (ik heb wat ervaring met msgbox e.d. dus ik dacht dat ik daar makkelijker een routine voor kon maken).
 
Dit gaat niet werken:

Code:
MsgBox ("Kloppen de volgende gegevens?" & vbCrLf & "Achternaam: " & achternaam & vbCrLf & "Voorletters: " & voorletters & vbCrLf & "Functie: " & functie & vbCrLf & "Afdeling: " & afdeling & vbCrLf & "Sleutel: " & sleutel & vbCrLf & "Handtekening: " & handtekening & vbCrLf & "Datum: " & datum), vbYesNo
If Response = vbYes Then

Code:
Response = MsgBox("Kloppen de volgende gegevens?" & vbCrLf & "Achternaam: " & achternaam & vbCrLf & "Voorletters: " & voorletters & vbCrLf & "Functie: " & functie & vbCrLf & "Afdeling: " & afdeling & vbCrLf & "Sleutel: " & sleutel & vbCrLf & "Handtekening: " & handtekening & vbCrLf & "Datum: " & datum, vbYesNo)

Het 1e gedeelte is je oorspronkelijke code.
Aan het eind van dat gedeelte wordt gecontroleerd wat de waarde van Response is.
Echter, de waarde van Response wordt pas in het 2e gedeelte bepaald.
Zo kan het wel:

Code:
Response = MsgBox("Kloppen de volgende gegevens?" & vbCrLf & "Achternaam: " & achternaam & vbCrLf & "Voorletters: " & voorletters & vbCrLf & "Functie: " & functie & vbCrLf & "Afdeling: " & afdeling & vbCrLf & "Sleutel: " & sleutel & vbCrLf & "Handtekening: " & handtekening & vbCrLf & "Datum: " & datum, vbYesNo)
If Response = vbYes Then

Oftewel je verwijdert het 1e gedeelte en je voeg de controle van Response na de msgbox.

Met vriendelijke groet,


Roncancio
 
De eerste loopt helemaal goed nu! heel mooi:D

de tweede nog niet helemaal, ik heb de Kolom_I deel weggedaan, en vervangen door wat u voorstelde.
de code ziet er nu zo uit:

----------------------------------------------------------------------------------------------------------------

Sub Dubbelclick()

Worksheet_BeforeDoubleClick(ByVal Target , Cancel As Boolean)
If Not Intersect(Target, Range("I2:I1000")) Is Nothing Then
If Target.Value = "" Then
With ActiveCell
.Value = "P"
.Font.Name = "Wingdings 2"
End With
Target.Offset(1, 0).Select
Else




With Target
ActiveCell.Value = ""
.Font.Name = "calibri"

End With

Target.Offset(1, 0).Select
End If
End If
End Sub


------------------------------------------------------------------------------------------------------------------------------------

Ik krijg alleen nog wel foutmeldingen, ik heb de sub een naam gegeven en de eerste rij verder naar beneden gehaald, maar verder helpt het niet bij de compileerfout, syntaxis foutmelding
het tweede deel daarvan wil dus nog niet, Roncancio enig idee hoe dit te verhelpen?


(ik moet nu weg, vanmiddag zal ik het weer oppakken. hartelijk dank voor de hulp!)
 
Laatst bewerkt:
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("I2:I1000")) Is Nothing Then
If Target.Value = "" Then
           With ActiveCell
            .Value = "P"
            .Font.Name = "Wingdings 2"
           End With
               Target.Offset(1, 0).Select
              Else
         
         
         
         
       With Target
        ActiveCell.Value = ""
                   .Font.Name = "calibri"
 
        End With

        Target.Offset(1, 0).Select
End If
End If
End Sub

Zet deze code niet in 'module1' maar achter 'Sheet1'

Dan werkt het wel, zie mijn voorbeeld in andere topic.
 
Dit gaat niet werken:

Code:
Sub Dubbelclick()

Worksheet_BeforeDoubleClick(ByVal Target , Cancel As Boolean)

De code moet gestart worden als je dubbelklik op een cel.
Dat betekent dat je de Event Worksheet_BeforeDoubleClick kan gebruiken.
Je moet dus macro geen gebruiken.
Dus:

Code:
Sub Worksheet_BeforeDoubleClick(ByVal Target, Cancel As Boolean)
If Not Intersect(Target, Range("I2:I1000")) Is Nothing Then
    If Target.Value = "" Then
        With ActiveCell
            .Value = "P"
            .Font.Name = "Wingdings 2"
        End With
    Else
        With Target
            .Value = ""
            .Font.Name = "calibri"
        End With
    End If
End If
End Sub

Met vriendelijke groet,


Roncancio
 
Beide Macro's werken, ik heb ze naar het officiele bestand geplakt. Wanneer getest in VBS werkt de eerste macro goed. De tweede werkt ook in de map prima.

Echter nu probeer ik de macro van het toevoegen van een persoon aan een afbeelding "+" te koppelen. dit lukt voor zover het altijd gaat. Alleen wanneer ik de macro probeer te activeren krijg ik een foutmelding dat de macro niet kan worden uitgevoerd. De macro is wellicht niet beschikbaar in dit werkboek of alle macro's zijn mogelijk uitgeschakeld.

echter ik weet dat de macro's het wel doen. want andere functioneren wel.

en daarnaast heb ik bij MVS de macro in de module staan, dus zou die toch moeten werken? of moet die ook in het werkboek vermeld staan?



CORRECTIE,

Ik kijk zelf niet goed, de naam was niet correct gekoppierd hij doet het volledig!

HARTELIJK DANK aan : Roncancio en popipipo
 
Laatst bewerkt:
Graag nog de vraag op opgelost zetten.
Bvd.

Met vriendelijke groet,


Roncancio
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan