Fout 1004 bij soortgelijke script.

Status
Niet open voor verdere reacties.
B

btr200bhp

Gebruiker
Lid geworden
6 mrt 2010
Berichten
16
Zit met een hersenkraker (voor mij dan)...
Ik heb 4 sheets met vba-scripts gemaakt waar ik met een entryform gegevens opsla een ander blad.
In mijn eerste file werkt deze script perfect maar als ik deze in mijn tweede (en 3e en 4e) gebruik krijg ik steeds die foutmelding.
Effe voor het plaatje:
Bestanden klanten, charters, laadplaats, losplaats.
Ieder bestand heeft "data" en "entry" blad (KL-Data, KL-Entry, CH-Data, enz...)
Bestand klanten met deze script werkt.
Code: 
Option Explicit


Function ValKlant() As Boolean

    Dim frm As Worksheet
    
    Set frm = ThisWorkbook.Sheets("KL-Entry")
    
    ValKlant = True
    
    With frm
    
        .Range("L7").Interior.Color = xlNone
        .Range("L9").Interior.Color = xlNone
        .Range("L11").Interior.Color = xlNone
        .Range("L13").Interior.Color = xlNone
        .Range("L15").Interior.Color = xlNone
        .Range("L17").Interior.Color = xlNone
        .Range("L19").Interior.Color = xlNone
        .Range("L21").Interior.Color = xlNone
        .Range("L23").Interior.Color = xlNone
        .Range("AO7").Interior.Color = xlNone
        .Range("AO9").Interior.Color = xlNone
        .Range("AO11").Interior.Color = xlNone
        .Range("AO13").Interior.Color = xlNone
        .Range("AO15").Interior.Color = xlNone
        .Range("AO17").Interior.Color = xlNone
        .Range("AO19").Interior.Color = xlNone
        .Range("AO21").Interior.Color = xlNone
            
    End With
    
    'Validating area
    
    If Trim(frm.Range("L7").Value) = "" Then
        MsgBox "Klantnaam is leeg.", vbOKOnly + vbInformation, "Klantnaam"
        frm.Range("L7").Select
        frm.Range("L7").Interior.Color = vbRed
        ValKlant = False
        Exit Function
    End If

maar de script in charters en de andere files, waar ik na 100x alles nakijken concludeer (m.i.) dat ik geen tikfout heb gemaakt, werken niet.
Zodra ik mijn velden invoer en ik wil opslaan, dus vba oproep voor validate, komt de 1004-melding.
Onderstaande voor de duidelijkheid de volledige script.

Code: 
Option Explicit


Function ValCharter() As Boolean

    Dim frm As Worksheet
    
    Set frm = ThisWorkbook.Sheets("CH-Entry")
    
    ValCharter = True
    
    With frm
    
        .Range("L7").Interior.Color = xlNone
        .Range("L9").Interior.Color = xlNone
        .Range("L11").Interior.Color = xlNone
        .Range("L13").Interior.Color = xlNone
        .Range("L15").Interior.Color = xlNone
        .Range("L17").Interior.Color = xlNone
        .Range("L19").Interior.Color = xlNone
        .Range("L21").Interior.Color = xlNone
        .Range("L23").Interior.Color = xlNone
        .Range("AO7").Interior.Color = xlNone
        .Range("AO9").Interior.Color = xlNone
        .Range("AO11").Interior.Color = xlNone
        .Range("AO13").Interior.Color = xlNone
        .Range("AO15").Interior.Color = xlNone
        .Range("AO17").Interior.Color = xlNone
        .Range("AO19").Interior.Color = xlNone
        .Range("AO21").Interior.Color = xlNone
            
    End With
    
    'Validating area
    
    If Trim(frm.Range("L7").Value) = "" Then
        MsgBox "Charternaam is leeg.", vbOKOnly + vbInformation, "Charternaam"
        frm.Range("L7").Select
        frm.Range("L7").Interior.Color = vbRed
        ValCharter = False
        Exit Function
    End If
    
    If Trim(frm.Range("L9").Value) = "" Then
        MsgBox "Adres is leeg.", vbOKOnly + vbInformation, "Adres"
        frm.Range("L9").Select
        frm.Range("L9").Interior.Color = vbRed
        ValCharter = False
        Exit Function
    End If
    
    If Trim(frm.Range("L11").Value) = "" Then
        MsgBox "Postcode is leeg.", vbOKOnly + vbInformation, "Postcode"
        frm.Range("L11").Select
        frm.Range("L11").Interior.Color = vbRed
        ValCharter = False
        Exit Function
    End If
    
    If Trim(frm.Range("L13").Value) = "" Then
        MsgBox "Plaatsnaam is leeg.", vbOKOnly + vbInformation, "Plaatsnaam"
        frm.Range("L13").Select
        frm.Range("L13").Interior.Color = vbRed
        ValCharter = False
        Exit Function
    End If
    
    If Trim(frm.Range("L15").Value) = "" Then
        MsgBox "Land is leeg.", vbOKOnly + vbInformation, "Land"
        frm.Range("L15").Select
        frm.Range("L15").Interior.Color = vbRed
        ValCharter = False
        Exit Function
    End If
    
    If Trim(frm.Range("L21").Value) = "" Then
        MsgBox "Bankrekening is leeg.", vbOKOnly + vbInformation, "IBAN Nummer"
        frm.Range("L21").Select
        frm.Range("L21").Interior.Color = vbRed
        ValCharter = False
        Exit Function
    End If
    
    If Trim(frm.Range("AO11").Value) = "" Then
        MsgBox "Voer minstens 1 contactpersoon in.", vbOKOnly + vbInformation, "Contactpersoon"
        frm.Range("AO11").Select
        frm.Range("AO11").Interior.Color = vbRed
        ValCharter = False
        Exit Function
    
    End If
    
End Function

Sub CharterWissen()

    With Sheets("CH-Entry")
    
        .Range("L7").Interior.Color = xlNone
        .Range("L7").Value = ""
        
        .Range("L9").Interior.Color = xlNone
        .Range("L9").Value = ""
        
        .Range("L11").Interior.Color = xlNone
        .Range("L11").Value = ""
        
        .Range("L13").Interior.Color = xlNone
        .Range("L13").Value = ""
        
        .Range("L15").Interior.Color = xlNone
        .Range("L15").Value = ""
        
        .Range("L17").Interior.Color = xlNone
        .Range("L17").Value = ""
        
        .Range("L19").Interior.Color = xlNone
        .Range("L19").Value = ""
        
        .Range("L21").Interior.Color = xlNone
        .Range("L21").Value = ""
        
        .Range("L23").Interior.Color = xlNone
        .Range("L23").Value = ""
        
        .Range("AO7").Interior.Color = xlNone
        .Range("AO7").Value = ""
        
        .Range("AO9").Interior.Color = xlNone
        .Range("AO9").Value = ""
        
        .Range("AO11").Interior.Color = xlNone
        .Range("AO11").Value = ""
        
        .Range("AO13").Interior.Color = xlNone
        .Range("AO13").Value = ""
        
        .Range("AO15").Interior.Color = xlNone
        .Range("AO15").Value = ""
        
        .Range("AO17").Interior.Color = xlNone
        .Range("AO17").Value = ""
        
        .Range("AO19").Interior.Color = xlNone
        .Range("AO19").Value = ""
        
        .Range("AO21").Interior.Color = xlNone
        .Range("AO21").Value = ""
        
    End With
     
End Sub

Sub CharterOpslaan()

    Dim frm As Worksheet
    Dim database As Worksheet
    
    Dim iRow As Long
    Dim iSerial As Long
    
    Set frm = ThisWorkbook.Sheets("CH-Entry")
    
    Set database = ThisWorkbook.Sheets("CH-Data")
    
    If Trim(frm.Range("M1").Value) = "" Then
    
        iRow = database.Range("A" & Application.Rows.Count).End(xlUp).Row + 1
        
        If iRow = 2 Then
        
            iSerial = 100001
            
        Else
        
            iSerial = database.Cells(iRow - 1, 1).Value + 1
            
        End If
        
    Else
    
        iRow = frm.Range("L1").Value
        iSerial = frm.Range("M1").Value
        
    End If
    
    With database
    
        .Cells(iRow, 1).Value = iSerial
        .Cells(iRow, 2).Value = frm.Range("L7").Value
        .Cells(iRow, 3).Value = frm.Range("L9").Value
        .Cells(iRow, 4).Value = frm.Range("L11").Value
        .Cells(iRow, 5).Value = frm.Range("L13").Value
        .Cells(iRow, 6).Value = frm.Range("L15").Value
        .Cells(iRow, 7).Value = frm.Range("L17").Value
        .Cells(iRow, 8).Value = frm.Range("L19").Value
        .Cells(iRow, 9).Value = frm.Range("AO7").Value
        .Cells(iRow, 10).Value = frm.Range("AO9").Value
        .Cells(iRow, 11).Value = frm.Range("L21").Value
        .Cells(iRow, 12).Value = frm.Range("AO11").Value
        .Cells(iRow, 13).Value = frm.Range("AO13").Value
        .Cells(iRow, 14).Value = frm.Range("AO15").Value
        .Cells(iRow, 15).Value = frm.Range("AO17").Value
        .Cells(iRow, 16).Value = frm.Range("AO19").Value
        .Cells(iRow, 17).Value = frm.Range("AO21").Value
        .Cells(iRow, 18).Value = frm.Range("L23").Value
        .Cells(iRow, 19).Value = frm.Range("L30").Value
        .Cells(iRow, 20).Value = Application.UserName
        
       
    End With
    
    ' frm.Range("L1").Value = ""
    ' frm.Range("M1").Value = ""
    
End Sub

Hier is de regel .Range("L7").Interior.Color = xlNone geel gearceerd.
Het verwijderen van de With frm werkt ook niet.
Dan geeft hij dezelfde fout in de sub charterwissen aan op dezelfde regel als in validate.

Deze fout komt ook bij de overige 2 bestanden.

Wat doe ik fout???
 
En je document?
 
Charters is protected, klanten niet ...
Dan kan je ook geen parameters wijzigen vanuit VBA uiteraard.

Hef de bescherming op als ze niet hoeft of schakel ze uit (enkel voor VBA is voldoende) voor de procedure wordt aangeroepen.
 
Daar zat 'm het probleem inderdaad. Heb bij klanten bladbeveiliging de celeigenschappen wel aangevinkt en bij de andere bestanden niet.
Deze aangepast en nu werkt het wel.
Dankjewel
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan