Hallo,..
Ik heb een bestand die perfect draait!
Echter zodra ik dit bestand deel (wat toch wel noodzakelijk is gezien de functie),.. geeft het een foutmelding:
Fout 1004 tijdens uitvoering:
Eigenschap MergeCells van klasse Range kan niet worden ingesteld.
Ik kan niet terugvinden hoe deze melding kan ontstaan, aangezien er geen sprake is van samengevoegde cellen in het bestand en dit wordt ook niet verzocht in de code!
Weet iemand waar het aan kan liggen?
Ik heb een bestand die perfect draait!
Echter zodra ik dit bestand deel (wat toch wel noodzakelijk is gezien de functie),.. geeft het een foutmelding:
Fout 1004 tijdens uitvoering:
Eigenschap MergeCells van klasse Range kan niet worden ingesteld.
Ik kan niet terugvinden hoe deze melding kan ontstaan, aangezien er geen sprake is van samengevoegde cellen in het bestand en dit wordt ook niet verzocht in de code!
Weet iemand waar het aan kan liggen?
Code:
Private Sub CommandButton1_Click()
'index
With ActiveSheet.UsedRange
endrow = .Cells(.Cells.Count).row
End With
MergeCells = False
'wachtwoord opgeven
Dim ww As String
ww = InputBox("Voer wachtwoord in")
If ww = "2013" Then
'***Juiste opmaak meegeven
Sheets("Blad1").Range("A9:E100").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Name = "Century Gothic"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'open de database
Workbooks.Open Filename:="Heb link even weggehaald ivm privacy!"
'juiste sheet in de database
Windows("database 2016.XLSm").Activate
'***zoek de eerste lege rij in de database
Sheets("Blad1").Activate
Sheets("Blad1").Range("A17").Select
If Not Sheets("Blad1").Range("A17").Value = "" Then
Selection.End(xlDown).Offset(1, 0).Select
End If
'***kopieer de gegevens uit het formulier van de juiste sheet
Windows("formulier 2016.XLSm").Activate
Sheets("Blad1").Range("a9:g250").Copy
'***plak de waarden in de database
Windows("database 2016.XLSm").Activate
Sheets("Blad1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'***Verwijder de niet gecontroleerde regels in de database
ActiveWorkbook.Sheets("Saskia").Range("F:F"). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
'Sla database op en sluit af
ActiveWorkbook.Save
ActiveWorkbook.Close
'***Ga terug naar formulier
Windows("formulier 2016.XLSm").Activate
Sheets("Blad1").Cells(9, 1).Select
'Verwijder de gecontroleerde regels in de database
Dim LastRow As Long
LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
For X = LastRow To 1 Step -1
If Range("F" & X).Value = "Ja" Then Range("A" & X).EntireRow.Delete
Next
LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
For X = LastRow To 1 Step -1
If Range("F" & X).Value = "Nee" Then Range("A" & X).EntireRow.Delete
Next
'Sla formulier op
ActiveWorkbook.Save
'wachtwoord opgeven indien onjuist
Else
MsgBox ("Wachtwoord onjuist; geen toegang")
End If
End Sub
