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

Wegschrijven naar vestigingsnummer

Status
Niet open voor verdere reacties.
J

Jarodxxx

Gebruiker
Lid geworden
26 nov 2006
Berichten
243
Onderstaande code kopieert ingevulde gegevens uit een userform naar een extern bestand
(hier alleen rij 11 in het bestand)

Alleen wordt het nu gekopieerd naar dit bestand en onderaan de rij neergezet.
Wat ik probeer te doen is dat het gekopieerd wordt zoals nu, alleen moet het in de rij waarvan het nummer in kolom A overeenkomt met het veld txbnummer

vb: nr = 1100 in de userform ("txbnummer") dan kopieeren naar bestand en in de rij waar nummer 1100 staat kopieren in rij 11

Code: 
Public Sub CommandButtonWijzigenAlgemeen_Click()
Dim MFC As Workbook, TCOR As Workbook, Rij As Long

Set MFC = ThisWorkbook

Application.ScreenUpdating = False

'Plaats eerst een popup schermpje om te vragen of de gegevens echt opgeslagen dienen te worden
response = MsgBox("Weet u zeker dat u deze gegevens wilt opslaan?", vbYesNo, Title:="Gegevens opslaan?")
'is het antwoord nee verlaat dan het scherm
    If response = vbNo Then

 Exit Sub

    End If

'Controle of alles ingevuld is
    On Error Resume Next '''
        If txbNaamContactpersoonPBM <> "" Then
    Else
        Application.ScreenUpdating = True
            MsgBox ("De gegevens zijn nog niet volledig ingevuld!")
           Exit Sub
    End If

'Opbouw array
    big(1, 0) = 535: big(1, 1) = 7
    big(2, 0) = 1040: big(2, 1) = 4
    big(3, 0) = 1140: big(3, 1) = 4
    big(4, 0) = 384: big(4, 1) = 3
    big(5, 0) = 1013: big(5, 1) = 4

'GEGEVENS WEGSCHRIJVEN NAAR HET TEST1'
    
'Op tabblad TEST1 een lege rij zoeken
    Set TCOR = Workbooks.Open("C:\Stamkaart\Test1.xls")
    Sheets("Test1").Activate
    ActiveSheet.Unprotect "PLIEGER"
    Rij = Range("B1").End(xlDown).Row + 1
    
'Gegevens kopieren naar TEST1'
    ActiveSheet.Unprotect "PLIEGER"
    With MFC.Sheets("Test1")
        Cells(Rij, 11) = txbNaamContactpersoonPBM
    End With
    
    ActiveSheet.Protect "PLIEGER"

Workbooks("Test1.xls").Save
Workbooks("Test1.xls").Close
    
Application.ScreenUpdating = True
    MsgBox ("De gegevens zijn opgeslagen")
Application.ScreenUpdating = True
   
End Sub

2. Is dit een goede methode om gegevens weg te schrijven naar een extern bestand, of doe ik het helemaal niet slim?

Jarod
 
Werkt dit?

Code: 
Public Sub CommandButtonWijzigenAlgemeen_Click()
Dim MFC As Workbook, TCOR As Workbook, Rij As Long

Set MFC = ThisWorkbook

Application.ScreenUpdating = False

'Plaats eerst een popup schermpje om te vragen of de gegevens echt opgeslagen dienen te worden
response = MsgBox("Weet u zeker dat u deze gegevens wilt opslaan?", vbYesNo, Title:="Gegevens opslaan?")
'is het antwoord nee verlaat dan het scherm
    If response = vbNo Then Exit Sub

'Controle of alles ingevuld is
    On Error Resume Next '''
        If txbNaamContactpersoonPBM <> "" Then
    Else
        Application.ScreenUpdating = True
            MsgBox ("De gegevens zijn nog niet volledig ingevuld!")
           Exit Sub
    End If

'Opbouw array
    big(1, 0) = 535: big(1, 1) = 7
    big(2, 0) = 1040: big(2, 1) = 4
    big(3, 0) = 1140: big(3, 1) = 4
    big(4, 0) = 384: big(4, 1) = 3
    big(5, 0) = 1013: big(5, 1) = 4

'GEGEVENS WEGSCHRIJVEN NAAR HET TEST1'
    
'Op tabblad TEST1 een lege rij zoeken
    Set TCOR = Workbooks.Open("C:\Stamkaart\Test1.xls")
    Sheets("Test1").Activate
    ActiveSheet.Unprotect "PLIEGER"
    Rij = Range("B1").End(xlDown).Row + 1
    
'Gegevens kopieren naar TEST1'
    With MFC.Sheets("Test1")
        Cells(Val(txbnummer.Text), 11) = txbNaamContactpersoonPBM
    End With
    
    ActiveSheet.Protect "PLIEGER"

Workbooks("Test1.xls").Close True
    
    MsgBox ("De gegevens zijn opgeslagen")
Application.ScreenUpdating = True
   
End Sub

Wigi
 
Lijkt erop

Mooi methode!

Helaas een maar (sorry voor de slechte uitleg:-))

Ik bedoelde dat hij kijkt in kolom A of textbox txbnummer value uit het formulier aanwezig is in de sheet en dat ie dan de gegevens in die rij zet.

vb: hij ziet dat 1100 uit txbnummer staat in rij 99 dan zet hij de te kopieren gegevens in kolom 11 (K?)

Dan zit ik niet vast aan de rijregel dus, want dat gaat problemen geven:-)

Jarod.
 
Laatst bewerkt:
Test eens uit:

Code: 
Public Sub CommandButtonWijzigenAlgemeen_Click()
Dim MFC As Workbook, TCOR As Workbook, Rij As Long, GevondenCel As Range

Set MFC = ThisWorkbook

Application.ScreenUpdating = False

'Plaats eerst een popup schermpje om te vragen of de gegevens echt opgeslagen dienen te worden
response = MsgBox("Weet u zeker dat u deze gegevens wilt opslaan?", vbYesNo, Title:="Gegevens opslaan?")
'is het antwoord nee verlaat dan het scherm
    If response = vbNo Then Exit Sub

'Controle of alles ingevuld is
    On Error Resume Next '''
        If txbNaamContactpersoonPBM <> "" Then
    Else
        Application.ScreenUpdating = True
            MsgBox ("De gegevens zijn nog niet volledig ingevuld!")
           Exit Sub
    End If

'Opbouw array
    big(1, 0) = 535: big(1, 1) = 7
    big(2, 0) = 1040: big(2, 1) = 4
    big(3, 0) = 1140: big(3, 1) = 4
    big(4, 0) = 384: big(4, 1) = 3
    big(5, 0) = 1013: big(5, 1) = 4

'GEGEVENS WEGSCHRIJVEN NAAR HET TEST1'
    
'Op tabblad TEST1 een lege rij zoeken
    Set TCOR = Workbooks.Open("C:\Stamkaart\Test1.xls")
    Sheets("Test1").Activate
    ActiveSheet.Unprotect "PLIEGER"
    Rij = Range("B1").End(xlDown).Row + 1

'Gegevens kopieren naar TEST1'
    With MFC.Sheets("Test1")
        If WorksheetFunction.CountIf(.Columns(1), Val(txbnummer.Text)) = 0 Then
            MsgBox "Dit komt niet voor"
            Exit Sub
        Else
            GevondenCel = .Columns(1).Find(Val(txbnummer.Text), xlWhole)
            Cells(GevondenCel.Row, 11) = txbNaamContactpersoonPBM
        End If
    End With
    
    ActiveSheet.Protect "PLIEGER"

Workbooks("Test1.xls").Close True
    
    MsgBox ("De gegevens zijn opgeslagen")
Application.ScreenUpdating = True
   
End Sub

Wigi
 
Niets gevonden

Wigi,

Dit lijkt de goede weg, maar hij zegt alleen "Dit komt niet voor"
Controlerend dan staat het nummer in txbnummer wel in het bestand test1 met sheet test1.

Hij kijkt nu dus naar kolom 1 en checkt of het nummer wat in txbnummer staat overeenkomt in de sheet.

txbnummer wordt weergegeven met:
txbnummer.Value = Format(Sheets("Algemeen").Range("C6"))

is dit nog van invloed misschien?

Jarod
 
Doe maar eens een voorbeeldbestandje want normaal zou het moeten werken als het wel degelijk in kolom A van dat bestand staat.
 
U vraagt....

Ik was al bezig:-)
Had ik verwacht!
Ik zie vast iets fundamenteels over het hoofd in dit voorbeeld

Hier is 't ie!

Groeten,

Jarod
 

Bijlagen

Laatst bewerkt:
Wigi

Ik ben d'r nog steeds niet uit waarom 't voorbeeld ook niet werkt.
Jij hebt ook nog geen geluk gehad met iets of heb je 't bestand nog nie gezien?

Gruse,

Jarod
 
Wie wil d'r alsjeblieft even naar kijken?

Hallo mensen,

't is echt hoge nood met deze:o

Als iets niet duidelijk is laat het dan even weten,
dan kijk ik wat ik kan doen!

Groeten,

Jarod.

ps: alvast bedankt voor het lezen!
 
Verbeterde code

Code: 
Dim big(10, 1) As Integer

Private Sub UserForm_Initialize()
txbnummer.Value = Format(Sheets("Algemeen").Range("C6"))
End Sub

Public Sub CommandButtonWijzigenAlgemeen_Click()
Dim MFC As Workbook, TCOR As Workbook, Rij As Long, GevondenCel As Range

Set MFC = ThisWorkbook

Application.ScreenUpdating = False

'Plaats eerst een popup schermpje om te vragen of de gegevens echt opgeslagen dienen te worden
response = MsgBox("Weet u zeker dat u deze gegevens wilt opslaan?", vbYesNo, Title:="Gegevens opslaan?")
'is het antwoord nee verlaat dan het scherm
    If response = vbNo Then Exit Sub

'Controle of alles ingevuld is
    On Error Resume Next '''
    If txbNaamContactpersoonPBM = "" Then
        Application.ScreenUpdating = True
        MsgBox ("De gegevens zijn nog niet volledig ingevuld!")
        Exit Sub
    End If

'Opbouw array
    big(1, 0) = 535: big(1, 1) = 7
    big(2, 0) = 1040: big(2, 1) = 4
    big(3, 0) = 1140: big(3, 1) = 4
    big(4, 0) = 384: big(4, 1) = 3
    big(5, 0) = 1013: big(5, 1) = 4

'GEGEVENS WEGSCHRIJVEN NAAR HET TEST1'
    
'Op tabblad TEST1 een lege rij zoeken
    Set TCOR = Workbooks.Open("C:\Test1.xls")
    Sheets("Test1").Activate
    
'Gegevens kopieren naar TEST1'
    With TCOR.Sheets("Test1") '!!
        .Unprotect "PLIEGER"
        Rij = .Range("A1").End(xlDown).Row + 1 '!!
        If WorksheetFunction.CountIf(.Columns(1), Val(txbnummer.Text)) = 0 Then
            MsgBox "Dit komt niet voor"
            Exit Sub
        Else
            Set GevondenCel = .Columns(1).Find(Val(Me.txbnummer.Text), lookat:=xlWhole, LookIn:=xlValues)
            .Cells(GevondenCel.Row, 11) = Me.txbNaamContactpersoonPBM.Text
        End If
    End With
    
    On Error GoTo 0
    TCOR.Sheets("Test1").Protect "PLIEGER"
    TCOR.Close True
    MsgBox ("De gegevens zijn opgeslagen")
    Application.ScreenUpdating = True
End Sub

Wigi
 
Touche!

in 1x goed!

Bedankt man:)
Hmmz... en ik m'n hoofd maar breken.
Dit had ik zelf ook ongeveer moeten kunnen bedenken ondertussen!
Ik werd helemaal scheel.

Je wordt hartelijk bedankt!

Jarod.
 
Ben zelf ook nog aan het stoeien geweest mbv de 1e code van Wigi.
Blij dat het nu werk, kwam er eigenlijk niet direct uit.
Begin nu zelf ook een beetje in de array's te komen.

@Wigi,
Nice avatar :D
 
Meerdere textboxen schrijven

Nog een laatste vraag (voor deze post iig;) )

je gebruikt onderstaand stukje

Code: 
           Set GevondenCel = .Columns(1).Find(Val(Me.txbnummer.Text), lookat:=xlWhole, LookIn:=xlValues)
            .Cells(GevondenCel.Row, 11) = Me.txbNaamContactpersoonPBM.Text

Voor meerdere textboxen (en dus meerdere rijen in de excelsheet test1.xls) is dit gewoon te kopieren en te plakken (met een andere textboxnaam).

duzz:

Code: 
            Set GevondenCel = .Columns(1).Find(Val(Me.txbnummer.Text), lookat:=xlWhole, LookIn:=xlValues)
            .Cells(GevondenCel.Row, 11) = Me.txbNaamContactpersoonPBM.Text            Set GevondenCel = .Columns(1).Find(Val(Me.txbnummer.Text), lookat:=xlWhole, LookIn:=xlValues)
            .Cells(GevondenCel.Row, 11) = Me.txbNaamContactpersoonPBM.Text

Vraag die dan bij mij ontstaat is dit code 'technisch' beter op te lossen?
vb: hij kijkt 1x en schrijft dan allebei de cellen in de afzonderlijke rij.
Volgens mij doet ie 't nu in 2x? klopt dat?

Groet,

JC

ps: Demeter, leuk dat je ook mee helpt, jij ook bedankt.
 
Jarodxxx zei:
Code: 
            Set GevondenCel = .Columns(1).Find(Val(Me.txbnummer.Text), lookat:=xlWhole, LookIn:=xlValues)
            .Cells(GevondenCel.Row, 11) = Me.txbNaamContactpersoonPBM.Text            Set GevondenCel = .Columns(1).Find(Val(Me.txbnummer.Text), lookat:=xlWhole, LookIn:=xlValues)
            .Cells(GevondenCel.Row, 11) = Me.txbNaamContactpersoonPBM.Text

Vraag die dan bij mij ontstaat is dit code 'technisch' beter op te lossen?
vb: hij kijkt 1x en schrijft dan allebei de cellen in de afzonderlijke rij.
Volgens mij doet ie 't nu in 2x? klopt dat?

Groet,

JC
Klik om te vergroten...

Doe het maar zo, met mijn permissie ;)

Je gebruikt wel 2 keer dezelfde regel code...

Wigi
 
Met textboxnaam

Natuurlijk wel met een andere textbox:-):o

Jarod.

ps: dan nog steeds handig?:D
 
Doe het maar zo, met mijn permissie
Klik om te vergroten...
Daar ga ik niet tegen in:D

Maar...... volgens mij kan: lookat:=xlWhole, LookIn:=xlValues nog wel weg (is wel wat directer in zoeken, maar is niet verplicht)
 
Demeter zei:
Daar ga ik niet tegen in:D

Maar...... volgens mij kan: lookat:=xlWhole, LookIn:=xlValues nog wel weg (is wel wat directer in zoeken, maar is niet verplicht)
Klik om te vergroten...

Best laten staan.

De Find neemt de instelling over die op dat moment van toepassing zijn, vandaar.
 
tx guys

Toppie,

Ik was nieuwsgierig!
Ik zal 't zo laten master;) :)

Groeten,

JC
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan