Koppelen aan de nummering

chimene · 24 jan 2008

beste helpers,

Wij hebben een excelbestand voor een prive videotheek .

Dit bestand is door iemand anders gemaakt en nu zit er een fout in de macro ( denk ik )

Het volgende probleem doet zich voor, als er nu dvd of video`s toegevoegd worden aan de lijst worden deze niet meer gekoppeld aan de nummering.

Dus als je dan een video of dvd nummer intypt komt de titel niet meer tevoorschijn.

Dus benummering loopt van 1 t/m 8107 en als er nu dus titels worden toegevoegd worden ze niet meer gekoppeld.

Ik weet het is een beetje vaag maar ik hoop dat er iemand wijs uit en mij kan helpen.

Ginger · 24 jan 2008

Chimene, de gezamelijke helpers van Helpmij.NL kunnen (bijna) alles oplossen. Maar (helaas) zijn we niet helderziend.

Je zal dus echt een bijlage moeten plaatsen of toch minimaal de code...
Maareh... Je kan de 'maker' niet meer contacten???

Groet, Leo

chimene · 24 jan 2008

dat is jammer geen jomanda`s bij helpmij!

Dit is de eerste macro

Code:

Dim strNaam As String
Dim strTabNaam As String
Dim bNaamBestaat As Boolean
Dim intRij As Integer
Dim strVoornaam As String
Dim strTussenvoegsel As String
Dim strAchternaam As String
Dim strAdres As String
Dim strPostcode As String
Dim strPlaats As String
Dim strVorigeSheet As String

Sub BeveiligingOpheffen()
    For x = 2 To 81
        Sheets(x).Select
        ActiveSheet.Unprotect
    Next x
End Sub
Sub TritsAanmaken()
    strVorigeSheet = "Deelnemerslijst"
    For x = 75 To 80
        Sheets("Deelnemerslijst").Select
        intRij = Selection.Row
        t$ = "A" & Trim$(Str(x))
        Range(t$).Select
        Selection.Copy
        strNaam = Selection
        Call BladAanmaken
        'Naam hyperlinken aan Tabblad
        Sheets("Deelnemerslijst").Select
        If InStr(1, strNaam, " ") Then
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & strNaam & "!A1'", TextToDisplay:=strNaam
        Else
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        strNaam & "!A1", TextToDisplay:=strNaam
        'Verwijzing naar totaalbedrag in deelnemerslijst opnemen
        Range("G" & Trim$(Str(x))).Select
        ActiveCell.FormulaR1C1 = "=" & strNaam & "!R[" & Trim$(Str(122 - x)) & "]C[-1]"
        
        End If

    Next x
End Sub
Sub BladAanmaken()
    Sheets("org").Select
    'sheet 'org' beveiliging opheffen
    ActiveSheet.Unprotect
    Sheets("org").Copy After:=Sheets(strVorigeSheet)
    Application.CutCopyMode = False
    Call FormulesInvullen
        'nieuw sheet deelnemersnaam geven
            'nagaan of er al een sheet met deze naam bestaat
            Call GeefTabNaam(strNaam)
        Sheets("org (2)").Select
        Sheets("org (2)").Name = strNaam
        strVorigeSheet = strNaam 'Na deze sheet komt de volgende
    'sheet terug beveiligen
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sub FormulesInvullen()
    'welke rij = actief op deelnemerslijst
    strRij = "R[" & Trim$(Str$(intRij - 1)) & "]"
    'koppeling tussen deelnemerslijst en p[ersoonlijk blad maken
    Sheets("org (2)").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=Deelnemerslijst!" & strRij & "C"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=Deelnemerslijst!" & strRij & "C"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=Deelnemerslijst!" & strRij & "C"
    Range("D2:G2").Select
    ActiveCell.FormulaR1C1 = _
        "=Deelnemerslijst!" & strRij & "C&"", ""&Deelnemerslijst!" & strRij & "C[1]&""  ""&Deelnemerslijst!" & strRij & "C[2]"
    Range("D3").Select
End Sub

Sub GeefTabNaam(strNaam)
    bNaamBestaat = True
    t1 = 0
    Do Until bNaamBestaat = False
        For t = 1 To Sheets.Count
            If Worksheets(t).Name = strNaam Then
                bNaamBestaat = True
                t1 = t1 + 1
                strNaam = strNaam + Trim$(Str(t1))
                Exit For
            Else: bNaamBestaat = False
            End If
        Next t
    Loop
End Sub

Dit de 2e

Dim strNaam As String
Dim strTabNaam As String
Dim bNaamBestaat As Boolean
Dim intRij As Integer
Dim strVoornaam As String
Dim strTussenvoegsel As String
Dim strAchternaam As String
Dim strAdres As String
Dim strPostcode As String
Dim strPlaats As String
Dim strVorigeSheet As String

Sub BeveiligingOpheffen()
    For x = 2 To 81
        Sheets(x).Select
        ActiveSheet.Unprotect
    Next x
End Sub
Sub TritsAanmaken()
    strVorigeSheet = "Deelnemerslijst"
    For x = 75 To 80
        Sheets("Deelnemerslijst").Select
        intRij = Selection.Row
        t$ = "A" & Trim$(Str(x))
        Range(t$).Select
        Selection.Copy
        strNaam = Selection
        Call BladAanmaken
        'Naam hyperlinken aan Tabblad
        Sheets("Deelnemerslijst").Select
        If InStr(1, strNaam, " ") Then
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & strNaam & "!A1'", TextToDisplay:=strNaam
        Else
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        strNaam & "!A1", TextToDisplay:=strNaam
        'Verwijzing naar totaalbedrag in deelnemerslijst opnemen
        Range("G" & Trim$(Str(x))).Select
        ActiveCell.FormulaR1C1 = "=" & strNaam & "!R[" & Trim$(Str(122 - x)) & "]C[-1]"
        
        End If

    Next x
End Sub
Sub BladAanmaken()
    Sheets("org").Select
    'sheet 'org' beveiliging opheffen
    ActiveSheet.Unprotect
    Sheets("org").Copy After:=Sheets(strVorigeSheet)
    Application.CutCopyMode = False
    Call FormulesInvullen
        'nieuw sheet deelnemersnaam geven
            'nagaan of er al een sheet met deze naam bestaat
            Call GeefTabNaam(strNaam)
        Sheets("org (2)").Select
        Sheets("org (2)").Name = strNaam
        strVorigeSheet = strNaam 'Na deze sheet komt de volgende
    'sheet terug beveiligen
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sub FormulesInvullen()
    'welke rij = actief op deelnemerslijst
    strRij = "R[" & Trim$(Str$(intRij - 1)) & "]"
    'koppeling tussen deelnemerslijst en p[ersoonlijk blad maken
    Sheets("org (2)").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=Deelnemerslijst!" & strRij & "C"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=Deelnemerslijst!" & strRij & "C"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=Deelnemerslijst!" & strRij & "C"
    Range("D2:G2").Select
    ActiveCell.FormulaR1C1 = _
        "=Deelnemerslijst!" & strRij & "C&"", ""&Deelnemerslijst!" & strRij & "C[1]&""  ""&Deelnemerslijst!" & strRij & "C[2]"
    Range("D3").Select
End Sub

Sub GeefTabNaam(strNaam)
    bNaamBestaat = True
    t1 = 0
    Do Until bNaamBestaat = False
        For t = 1 To Sheets.Count
            If Worksheets(t).Name = strNaam Then
                bNaamBestaat = True
                t1 = t1 + 1
                strNaam = strNaam + Trim$(Str(t1))
                Exit For
            Else: bNaamBestaat = False
            End If
        Next t
    Loop
End Sub


Dit de 3e

Sub Macro1()
'
' Macro1 Macro
' De macro is opgenomen op 3-5-2007 door De Wingerd.
'

'
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=Addie!R[120]C[-4]"
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "=André!R[119]C[-4]"
    Range("J4").Select
    ActiveCell.FormulaR1C1 = "=Ankie!R[118]C[-4]"
    Range("J5").Select
End Sub

dit de 4e

Dim strNaam As String
Dim strTabNaam As String
Dim bNaamBestaat As Boolean
Dim intRij As Integer
Dim strVoornaam As String
Dim strTussenvoegsel As String
Dim strAchternaam As String
Dim strAdres As String
Dim strPostcode As String
Dim strPlaats As String
Dim strVorigeSheet As String

Sub BeveiligingOpheffen()
    For x = 2 To 81
        Sheets(x).Select
        ActiveSheet.Unprotect
    Next x
End Sub
Sub TritsAanmaken()
    strVorigeSheet = "Deelnemerslijst"
    For x = 75 To 80
        Sheets("Deelnemerslijst").Select
        intRij = Selection.Row
        t$ = "A" & Trim$(Str(x))
        Range(t$).Select
        Selection.Copy
        strNaam = Selection
        Call BladAanmaken
        'Naam hyperlinken aan Tabblad
        Sheets("Deelnemerslijst").Select
        If InStr(1, strNaam, " ") Then
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & strNaam & "!A1'", TextToDisplay:=strNaam
        Else
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        strNaam & "!A1", TextToDisplay:=strNaam
        'Verwijzing naar totaalbedrag in deelnemerslijst opnemen
        Range("G" & Trim$(Str(x))).Select
        ActiveCell.FormulaR1C1 = "=" & strNaam & "!R[" & Trim$(Str(122 - x)) & "]C[-1]"
        
        End If

    Next x
End Sub
Sub BladAanmaken()
    Sheets("org").Select
    'sheet 'org' beveiliging opheffen
    ActiveSheet.Unprotect
    Sheets("org").Copy After:=Sheets(strVorigeSheet)
    Application.CutCopyMode = False
    Call FormulesInvullen
        'nieuw sheet deelnemersnaam geven
            'nagaan of er al een sheet met deze naam bestaat
            Call GeefTabNaam(strNaam)
        Sheets("org (2)").Select
        Sheets("org (2)").Name = strNaam
        strVorigeSheet = strNaam 'Na deze sheet komt de volgende
    'sheet terug beveiligen
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sub FormulesInvullen()
    'welke rij = actief op deelnemerslijst
    strRij = "R[" & Trim$(Str$(intRij - 1)) & "]"
    'koppeling tussen deelnemerslijst en p[ersoonlijk blad maken
    Sheets("org (2)").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=Deelnemerslijst!" & strRij & "C"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=Deelnemerslijst!" & strRij & "C"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=Deelnemerslijst!" & strRij & "C"
    Range("D2:G2").Select
    ActiveCell.FormulaR1C1 = _
        "=Deelnemerslijst!" & strRij & "C&"", ""&Deelnemerslijst!" & strRij & "C[1]&""  ""&Deelnemerslijst!" & strRij & "C[2]"
    Range("D3").Select
End Sub

Sub GeefTabNaam(strNaam)
    bNaamBestaat = True
    t1 = 0
    Do Until bNaamBestaat = False
        For t = 1 To Sheets.Count
            If Worksheets(t).Name = strNaam Then
                bNaamBestaat = True
                t1 = t1 + 1
                strNaam = strNaam + Trim$(Str(t1))
                Exit For
            Else: bNaamBestaat = False
            End If
        Next t
    Loop
End Sub

Dit zijn alle macro`s die erin staan!

Ik hoop dat jullie hier iets mee kunnen!

Finch · 24 jan 2008

Gelieve deze tussen code tags te plaatsen, dat komt de leesbaarheid ten goede. Geen voorbeeldbestandje, wat alles toch net wat makkelijker maakt om te onderzoeken waar het probleem zit?

Ginger · 24 jan 2008

Ik haal uit de code nou ook niet direct het 'probleem'. Ik zit er meer aan te denken dat het ligt aan de formule die gekoppeld zit aan het 'in te tikken nummer' en wel door deze opmerking

Code:

Dus als je dan een video of dvd nummer intypt komt de titel niet meer tevoorschijn

Heb je soms in de cel waar de titel verschijnt een VLookup (Vert.Zoeken) functie staan? Dan zou het kunnen dat je tabel met CD's en DVD's inmiddels langer is dan het bereik in je formule.
Maar goed, het blijft koffiedik kijken zonder het volledige bestand. Ook al ben ik wel bang dat die ERG groot is, gezien de coderegel:

For x = 2 To 81
Sheets(x).Select
ActiveSheet.Unprotect
Next x

Groet, Leo

huijb · 24 jan 2008

@ chimene: De volgende keer als je weer zo'n lap code plaatst verwijder ik het. Ik bedoel natuurlijk, als het niet tussen de code tags staat. Lees dit even http://www.helpmij.nl/forum/showthread.php?t=278887

chimene · 24 jan 2008

Het is inderdaad nogal een zeer groot en uitgebreid bestand en er staan ook allerlei prive gegevens in dus lijkt mij dit niet verstandig om het te plaatsen.
Maar ik zal dan eens naar de formule laten kijken

Alvast bedankt voor het meedenken!

@ huijb Sorry!

Koppelen aan de nummering

chimene

Gebruiker

Ginger

Terugkerende gebruiker

chimene

Gebruiker

Finch

Terugkerende gebruiker

Ginger

Terugkerende gebruiker

huijb

Supermoderator

chimene

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy