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

userform geen nieuwe invoer mogelijk tijdens delen???

Status
Niet open voor verdere reacties.

jongsma63

Gebruiker
Lid geworden
1 aug 2012
Berichten
8
Heren ( en dames) goeroe's......

Ik ben nu al geruime tijd bezig met het maken en verbeteren met een excel bestand.
Tot zoverre ging alles goed, alleen ik wil het nu via het bedrijfsnetwerk gaan gebruiken.
Het is de bedoeling dat er meerdere gebruikers tegelijkertijd mee aan de slag kunnen.

Nu begint het spek te stinken......

Tijdens het delen van een werkblad kan het userformulier niet meer volledig worden gebruikt.

Is hier een speciale truc voor toevallig?!?!

Vast bedankt voor de info!
 
Misschien niet precies het antwoord dat je graag zou willen horen.
Maar excel is niet echt geschikt (of misschien wel echt niet geschikt) om op een netwerk te zetten om het tegelijk te kunnen gebruiken.
Vroeg of laat kom je dan toch in de problemen.
Die tijd is dus bij jou nu al (gelukkig?!) aangebroken.
 
Nou, Ik ben toch weer wat verder!!!!
Niet via de originele weg, maar ben er......
Hier de code die ik (deels) geleend heb, maar mij uit de brand heeft geholpen!

Private Sub cmdAdd_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim iRow As Long
Dim ws As Worksheet

iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1



If Trim(Me.txtomsch.Value) = "" Then
Me.txtomsch.SetFocus
MsgBox "Vul AUB een omschrijving in"
Exit Sub
End If
If Trim(Me.txtproject.Value) = "" Then
Me.txtomsch.SetFocus
MsgBox "Vul AUB een projectnummer in"
Exit Sub
End If
If Trim(Me.txtMOS.Value) = "" Then
Me.txtomsch.SetFocus
MsgBox "Vul AUB een MOSnummer in"
Exit Sub
End If
If Trim(Me.txtfig.Value) = "" Then
Me.txtomsch.SetFocus
MsgBox "Vul AUB een figuur nummer in"
Exit Sub
End If
If Trim(Me.txtNSN.Value) = "" Then
Me.txtomsch.SetFocus
MsgBox "Vul AUB een NSN nummer in"
Exit Sub
End If
If Trim(Me.txtnaam.Value) = "" Then
Me.txtomsch.SetFocus
MsgBox "Vul AUB de benaming uit het boek in"
Exit Sub
End If
With ws

If txtNSN.Value <> "" And Application.CountIf(.Range(.Cells(3, 5), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0).Row, 2)), txtNSN.Value) > 0 Then
MsgBox "Controleer het NSN even!, " & Chr(10) & Chr(10) & Me.txtNSN & Chr(10) & Chr(10) & " bestaat al in de database!", vbInformation
End If
End With

With ws
If txtSAP.Value <> "" And Application.CountIf(.Range(.Cells(2, 6), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0).Row, 2)), txtSAP.Value) > 0 Then
MsgBox "Controleer het SAP nummer !, " & Chr(10) & Chr(10) & Me.txtSAP & Chr(10) & Chr(10) & " bestaat al in de database!", vbInformation
Me.txtomsch.Value = ""
Me.txtproject.Value = ""
Me.txtMOS.Value = ""
Me.txtfig.Value = ""
Me.txtNSN.Value = ""
Me.txtSAP.Value = ""
Me.txtnaam.Value = ""
Cancel = True
End If

End With

[mySort]

ws.Cells(iRow, 1).Value = Me.txtomsch.Value
ws.Cells(iRow, 2).Value = Me.txtproject.Value
ws.Cells(iRow, 3).Value = Me.txtMOS.Value
ws.Cells(iRow, 4).Value = Me.txtfig.Value
ws.Cells(iRow, 5).Value = Me.txtNSN.Value
ws.Cells(iRow, 6).Value = Me.txtSAP.Value
ws.Cells(iRow, 7).Value = Me.txtnaam.Value



Me.txtomsch.Value = ""
Me.txtproject.Value = ""
Me.txtMOS.Value = ""
Me.txtfig.Value = ""
Me.txtNSN.Value = ""
Me.txtSAP.Value = ""
Me.txtnaam.Value = ""
Me.txtomsch.SetFocus



'set format cel
ws.Cells(iRow, 2).NumberFormat = "000000"
ws.Cells(iRow, 3).NumberFormat = "0000-0000"
ws.Cells(iRow, 4).NumberFormat = "00000"
ws.Cells(iRow, 5).NumberFormat = "00-000-0000"
ws.Cells(iRow, 6).NumberFormat = "10000000000"


'rijen tellen en rang selecteren
RowCount = ws.Range("A3").CurrentRegion.Rows.Count
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=Range("A3") _
, Sorton:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
x = "A3"
y = "G" & RowCount
With ws.Sort
.SetRange Range(x & ":" & y)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'ontdubbelen van gegevens

Dim z As Integer
For z = 3 To RowCount
For i = 1 To 5
If ws.Cells(z, 5) = "" Or _
ws.Cells(z, 5) = ws.Cells(z + i, 5) Or _
(ws.Cells(z, 6) = ws.Cells(z + i, 6) And _
ws.Cells(z, 6) <> "" And ws.Cells(z + i, 6) <> "") Then
ws.Rows(z).Delete
If ws.Cells(z + 1, 1) <> "" Then
z = z - 1
End If
Exit For
End If
Next i
Next z



einde:
[cmdClose_Click]
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Ik heb een aantal aanpassingen gedaan, zoals het automatisch sorteren en ontdubbelen met behulp van een collega.
Het is misschien een vrij "lange" code is voor iets simpels, maar ik ben er mee gered!

Nu werkt het invoeren van nieuwe gegevens wel tijdens delen!!!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan