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

opmaak wordt veranderd

Status
Niet open voor verdere reacties.
V

vaneijk

Gebruiker
Lid geworden
31 mrt 2017
Berichten
152
Beste helpers van het forum,

Ik heb een bestand gemaakt met diverse userforms. Vanuit deze userforms laat ik waardes wegschrijven naar diverse tabbladen. Echter wat er gebeurt na het wegschrijven van de data, is dat de opmaak van de cellen wordt veranderd naar datum. Dit gebeurt op meerdere sheets en ik kan niet bedenken wat hier de oorzaak van is. Kan iemand mij helpen/vertellen waar ik naar moet kijken, waar ik op moet letten of wat de oorzaak hiervan kan zijn?

mvg. E.
 
Zet een enkele quote voor de waarde die je naar zo'n cel schrijft: Range("A1") = "'" & waarde
Plaats anders je document.
 
Laatst bewerkt:
Goedemorgen Edmoor,
Ik gebruik onderstaande code om de data weg te schrijven, na het afsluiten van het userform is op meerdere tabbladen de opmaak veranderd en ik snap totaal niet waardoor dit komt.
Code: 
Private Sub CommandButton4_Click()  ''Plaats data in "Hoofdblad"
Application.ScreenUpdating = True
OffSheet1.Cells(11, 3).Value = Me.TextBox1.Value    ''Objectnaam
OffSheet1.Cells(13, 3).Value = Me.TextBox2.Value    ''Objectadres
OffSheet1.Cells(14, 3).Value = Me.TextBox3.Value    ''Objectpostcode
OffSheet1.Cells(15, 3).Value = Me.TextBox4.Value    ''Objectplaats

OffSheet1.Cells(16, 3).Value = Me.TextBox5.Value    ''Cont. Object
OffSheet1.Cells(17, 3).Value = Me.TextBox6.Value    ''Cont. tel.nr
OffSheet1.Cells(18, 3).Value = Me.TextBox7.Value    ''Cont. mob.nr
OffSheet1.Cells(19, 3).Value = Me.TextBox8.Value    ''Cont. e-mail

OffSheet1.Cells(21, 3).Value = Me.TextBox9.Value    ''Fact. Objectnaam
OffSheet1.Cells(22, 3).Value = Me.TextBox10.Value   ''Fact. T.a.v.
OffSheet1.Cells(23, 3).Value = Me.TextBox11.Value   ''Fact. adres
OffSheet1.Cells(24, 3).Value = Me.TextBox12.Value   ''Fact. postcode
OffSheet1.Cells(25, 3).Value = Me.TextBox13.Value   ''Fact. plaats
OffSheet1.Cells(26, 3).Value = Me.TextBox14.Value   ''Fact. e-mail
Unload Me
End Sub
 
Onderstaande code staat in het gehele userform
Code: 
Sub ImportObjectenBestand() ''Importeren van klantenbestand vanuit Acces
''ClearsheetImportklant ''"ImportKlnt"
txtzoek = ""
On Error GoTo Errhandler:
Application.ScreenUpdating = False
dbpath = DataSheet.Cells(7, 8).Value
''dbpath = "Z:\VanEijk\Offertes\VanEijk.accdb"
var = ""
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath
Sql = "SELECT * FROM ProjectenDb WHERE Id LIKE '" & var & "%" & "'"
Set rs = New ADODB.Recordset
rs.Open Sql, cnn
If rs.EOF And rs.BOF Then
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Application.ScreenUpdating = True
''MsgBox "Kan de klantendatabase niet vinden.", vbCritical, "Geen database gevonden"
Exit Sub
End If
Sheet8.Range("A3").CopyFromRecordset rs
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
On Error GoTo 0
Exit Sub
Errhandler:
Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Importeren van personeelsdata"
End Sub





Private Sub CommandButton2_Click()  ''Openen van offerte
If Me.ComboBox1.Value = "" Then
MsgBox "Offerte kiezen a.u.b.", vbInformation, "Geen offerte geselecteerd"
Me.ComboBox1.SetFocus
Exit Sub
End If

c00 = "Z:\VanEijk\Offertes\Excel\" & Left(ComboBox1.Value, 4) & "\" & ComboBox1.Value
c01 = Left(ComboBox1.Value, 4)
MsgBox c00
End Sub

Private Sub CommandButton5_Click() ''Toevoegen aan database
On Error GoTo Errhandler_Van_Eijk_DB:
dbpath = DataSheet.Cells(7, 8).Value  ''"VanEijk.accdb"
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath
Set rs = New ADODB.Recordset

rs.Open "SELECT * FROM Numbers " & _
"WHERE Art LIKE '" & "Projecten" & "'", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdText
If rs.EOF And rs.BOF Then
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox "Kan het nieuwe objectnummer niet wegschrijven naar database van de objecten.", vbCritical, "Fout met wegschrijven naar database"
Exit Sub
End If
Me.TextBox00.Caption = rs.Fields("Tot_Id").Value + 1
''''Sheet4.Cells(1, 2).Value = rs.Fields("Tot_Id").Value + 1
With rs
rs.Fields("Tot_Id").Value = rs.Fields("Tot_Id").Value + 1    ''rs = id_tot
rs.Fields("Lst_mut_by").Value = DataSheet.Cells(2, 3).Value  ''Lst_mut_by
rs.Fields("lst_mut").Value = Format(Date, "d-m-yyyy")        ''lst_mut
rs.Update
End With
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing

Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath
Set rs = New ADODB.Recordset
dbpath = DataSheet.Cells(7, 8).Value  ''"VanEijkPersoneel.accdb"
dbTabl = "ProjectenDb"
rs.Open Source:=dbTabl, ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
On Error Resume Next
With rs
.AddNew
.Fields("Id").Value = Me.TextBox00.Caption
.Fields("Zoeknaam").Value = Me.TextBox0.Value
.Fields("Objectnaam").Value = Me.TextBox1.Value
.Fields("Objectadres").Value = Me.TextBox2.Value
.Fields("ObjectPostcode").Value = Me.TextBox3.Value
.Fields("ObjectPlaats").Value = Me.TextBox4.Value
.Fields("Cont_Object").Value = Me.TextBox5.Value
.Fields("Tel_Cont_Object").Value = Me.TextBox6.Value
.Fields("Mob__Cont_Object").Value = Me.TextBox7.Value
.Fields("Email__Cont_Object").Value = Me.TextBox8.Value
.Fields("Fact_naam").Value = Me.TextBox9.Value
.Fields("Fact_TAV").Value = Me.TextBox10.Value
.Fields("Fact_adres").Value = Me.TextBox11.Value
.Fields("Fact_Postcode").Value = Me.TextBox12.Value
.Fields("Fact_Postplaats").Value = Me.TextBox13.Value
.Fields("Fact_Email").Value = Me.TextBox14.Value

.Fields("Location").Value = Me.Txtbox17.Value
.Fields("HistoryOff").Value = Replace(Me.TextBox15.Value, vbCrLf, " | ")
.Fields("HistoryWerk").Value = Me.Txtbox16.Value
''.Fields("Id_omschr").Value = Me.Txtbox19.Value
''.Fields("extra").Value = Me.Txtbox90.Value



.Fields("lst_myt_by").Value = DataSheet.Cells(2, 3).Value
.Fields("Lst_mut_date").Value = Format(Date, "d-m-yyyy")
.Update
End With
rs.Update
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox "De data is toegevoegd aan de objecten database"
Call UserForm_Initialize
On Error GoTo 0
Exit Sub
Errhandler_Van_Eijk_DB:
Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Toevoegen van data"
End Sub




Private Sub CommandButton3_Click() ''Bewerken database
ShowSheet "ImportPers"
'add error handling
On Error GoTo Errhandler:
If Me.TextBox00.Caption = "" Then
MsgBox "Een object selecteren.", _
vbOKOnly Or vbInformation, "Geen keuze gemaakt"
Exit Sub
End If
dbpath = DataSheet.Cells(7, 8).Value  ''Lokatie "VanEijkPersoneel.accdb"
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM ProjectenDb " & _
"WHERE ID = " & CLng(Me.TextBox00.Caption), ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdText
If rs.EOF And rs.BOF Then
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox "De geselecteerde persoon is niet gevonden!", vbCritical, "Fout met vinden van databasenummer"
Exit Sub
End If
On Error Resume Next

With rs

.Fields("Zoeknaam").Value = Me.TextBox0.Value
.Fields("Objectnaam").Value = Me.TextBox1.Value
.Fields("Objectadres").Value = Me.TextBox2.Value
.Fields("ObjectPostcode").Value = Me.TextBox3.Value
.Fields("ObjectPlaats").Value = Me.TextBox4.Value
.Fields("Cont_Object").Value = Me.TextBox5.Value
.Fields("Tel_Cont_Object").Value = Me.TextBox6.Value
.Fields("Mob__Cont_Object").Value = Me.TextBox7.Value
.Fields("Email__Cont_Object").Value = Me.TextBox8.Value
.Fields("Fact_naam").Value = Me.TextBox9.Value
.Fields("Fact_TAV").Value = Me.TextBox10.Value
.Fields("Fact_adres").Value = Me.TextBox11.Value
.Fields("Fact_Postcode").Value = Me.TextBox12.Value
.Fields("Fact_Postplaats").Value = Me.TextBox13.Value
.Fields("Fact_Email").Value = Me.TextBox14.Value

.Fields("Location").Value = Me.TextBox17.Value
.Fields("HistoryOff").Value = Replace(Me.TextBox15.Value, vbCrLf, " | ")
.Fields("HistoryWerk").Value = Replace(Me.TextBox16.Value, vbCrLf, " | ")
''.Fields("Id_omschr").Value = Me.Txtbox19.Value
''.Fields("extra").Value = Me.Txtbox90.Value



.Fields("lst_myt_by").Value = DataSheet.Cells(2, 3).Value
.Fields("Lst_mut_date").Value = Format(Date, "d-m-yyyy")
rs.Update
End With
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
'Inform the user that the macro was executed successfully.

MsgBox "De data is bijgewerkt", vbInformation, "Bijwerken geslaagd"
Call UserForm_Initialize
'error handler
On Error GoTo 0
Exit Sub
Errhandler:
'clear memory
Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure bewerken van personeelsdata"
End Sub



Private Sub CommandButton1_Click()  ''Open tekeningen lokatie
If Me.CommandButton1.Caption = "Tekeningen" Then
i = Me.ListBox1.ListIndex
Me.ListBox1.Selected(i) = True
If Me.ListBox1.ListIndex = -1 Then Exit Sub
If Me.ListBox1.Column(18, i) = "" Then
MsgBox "Lokatie van tekeningen is niet bekend."
Exit Sub
Else
responce = MsgBox("Hiermee opent u de map waar de tekeningen instaan, weet u dit zeker?", vbYesNo, "Map openen")
If Not responce = vbYes Then Exit Sub
''''''OPENEN VAN FOLDERMAP
str_folder = "Z:\VanEijk\Daktekeningen objecten\" & Me.ListBox1.Column(18, i) ' folder to open
Call Shell("explorer.exe " & str_folder, vbNormalFocus)
Exit Sub
End If

Else
On Error GoTo Errhandler:
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
Me.TextBox17.Value = Split(diaFolder.SelectedItems(1), "objecten\")(1) & "\"

Set diaFolder = Nothing
End If

Exit Sub
Errhandler:
Set diaFolder = Nothing
Response = MsgBox("Er is geen lokatie geselecteerd", vbCritical, "Geen keuze gemaakt")



End Sub

Private Sub CommandButton4_Click()  ''Plaats data in "Hoofdblad"
Application.ScreenUpdating = True
OffSheet1.Cells(11, 3).Value = Me.TextBox1.Value    ''Objectnaam
OffSheet1.Cells(13, 3).Value = Me.TextBox2.Value    ''Objectadres
OffSheet1.Cells(14, 3).Value = Me.TextBox3.Value    ''Objectpostcode
OffSheet1.Cells(15, 3).Value = Me.TextBox4.Value    ''Objectplaats

OffSheet1.Cells(16, 3).Value = Me.TextBox5.Value    ''Cont. Object
OffSheet1.Cells(17, 3).Value = Me.TextBox6.Value    ''Cont. tel.nr
OffSheet1.Cells(18, 3).Value = Me.TextBox7.Value    ''Cont. mob.nr
OffSheet1.Cells(19, 3).Value = Me.TextBox8.Value    ''Cont. e-mail

OffSheet1.Cells(21, 3).Value = Me.TextBox9.Value    ''Fact. Objectnaam
OffSheet1.Cells(22, 3).Value = Me.TextBox10.Value   ''Fact. T.a.v.
OffSheet1.Cells(23, 3).Value = Me.TextBox11.Value   ''Fact. adres
OffSheet1.Cells(24, 3).Value = Me.TextBox12.Value   ''Fact. postcode
OffSheet1.Cells(25, 3).Value = Me.TextBox13.Value   ''Fact. plaats
OffSheet1.Cells(26, 3).Value = Me.TextBox14.Value   ''Fact. e-mail
Unload Me
End Sub

Private Sub CommandButton6_Click()  ''Clear textbox
ClearTextBox
Me.ListBox1.ListIndex = -1
Me.CommandButton5.Visible = True
End Sub

Private Sub CommandButton7_Click()  '"Afsluiten
Unload Me
End Sub

Private Sub ListBox1_Click()

Me.CommandButton1.Visible = True
Me.CommandButton5.Visible = False
i = Me.ListBox1.ListIndex
Me.ListBox1.Selected(i) = True
Me.TextBox00.Caption = Me.ListBox1.Column(0, i)

For j = 1 To 15
Me.Controls("TextBox" & j - 1).Value = Me.ListBox1.Column(j + 2, i)
Next
Me.TextBox15.Text = Replace(Me.ListBox1.Column(19, i), " | ", vbCrLf)
Me.TextBox16.Text = Replace(Me.ListBox1.Column(20, i), " | ", vbCrLf)
Me.TextBox17.Value = Me.ListBox1.Column(18, i)
  c00 = Split(Replace(Me.ListBox1.Column(19, i), "#", "|"), " | ")
  For j = 0 To UBound(c00) Step 2
    c01 = c01 & "|" & c00(j)
  Next j
  ComboBox1.List = Split(c01, "|")

If Me.ListBox1.Column(18, i) = "" Then
Me.CommandButton1.Caption = "Kies lokatie"
Me.TextBox17.Visible = True
Else
Me.CommandButton1.Caption = "Tekeningen"
Me.TextBox17.Visible = False
End If

If Me.ListBox1.Column(18, i) = "" Then
Me.ComboBox1.Visible = False
Me.CommandButton2.Visible = False
Else
Me.ComboBox1.Visible = True
Me.CommandButton2.Visible = True
End If


Me.lst_mod_by.Caption = Me.ListBox1.Column(1, i)
Me.lst_mod_date.Caption = Format(Me.ListBox1.Column(2, i), "d-m-yyyy")

End Sub

Sub SortObjectRng()
rw = Sheet8.Range("B" & Rows.Count).End(xlUp).row
Rng = "A3:U" & rw
Sheet8.Range(Rng).Sort Sheet8.Range("D2"), 1, , , , , , xlGuess
End Sub





Private Sub txtzoek_Change()
sFind = txtzoek.Text
If Len(sFind) = 0 Then
ListBox1.ListIndex = -1
ListBox1.TopIndex = 0
Else
For i = 0 To ListBox1.ListCount - 1
For j = 0 To Sheet8.Cells(2, Columns.Count).End(xlToLeft).Column - 1
If InStr(UCase(ListBox1.List(i, j)), UCase(sFind)) > 0 Then
ListBox1.TopIndex = i
ListBox1.ListIndex = i
End If
Next j
Next i
End If
End Sub
Sub ClearTextBox()
For Each Ctrl In Controls
    If TypeName(Ctrl) = "TextBox" Or TypeName(Ctrl) = "ComboBox" Then
    Ctrl.Value = ""
    End If
    Next Ctrl
    Me.TextBox00.Caption = ""
End Sub


Private Sub UserForm_Activate()
Me.Tag = ActiveSheet.Name
If Me.Tag = "Hoofdblad" Then
OffSheet1.Select
Me.CommandButton4.Visible = True
Else
Sheet0.Select
Me.CommandButton4.Visible = False
End If
End Sub

Private Sub UserForm_Initialize()
ClearTextBox
ClearsheetImportObject
ImportObjectenBestand
SortObjectRng
rw = Sheet8.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).row
Set Rng = Sheet8.Range("A3:" & Split(Cells(1, Sheet8.Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & Sheet8.Range("A" & Rows.Count).End(xlUp).row)
With ListBox1
.Clear
.ColumnHeads = False
.ColumnCount = Rng.Columns.Count
.ColumnWidths = "0;0;0;100;0;0;0;75;0;0;0;0;0;0;0;0;0;0;0;0;0"
ReDim Myarray(Rng.Rows.Count, Rng.Columns.Count)
rw = 0
For i = 1 To Rng.Rows.Count
For j = 0 To Rng.Columns.Count
Myarray(rw, j) = Rng.Cells(i, j + 1)
Next
rw = rw + 1
Next
.List = Myarray
End With
Set Rng = Nothing
Me.CommandButton1.Visible = False
Me.CommandButton2.Visible = False
Me.ComboBox1.Visible = False
Me.TextBox17.Visible = False

End Sub
 
In die code heb je nog niet gedaan wat ik als eerste in m'n vorige reactie zei.
 
Die heb ik nu zojuist geprobeerd maar helaas veranderd hij nog de opmaak van alle cellen
 
enige wat ik me nu kan bedenken is alle cellen die veranderd worden, de opmaak terug te laten veranderen dmv
Code: 
    Selection.NumberFormat = "@"
 
De 2e regel in m'n eerste reactie heb je ook niet gedaan.
 
Klopt Edmoor, dit omdat er redelijk veel data van onze klanten instaat wat met vertrouwen behandeld moet worden. Ik zou het originele bestand compleet moeten aanpassen en de access database waar ik alles uit laat uploaden ook..... Ik hoopte eigenlijk dat dit een vaker voorkomend probleem is wat met een "simpele" oplossing kan worden opgelost
 
Als je de Excel cellen bedoelt die van eigenschap veranderen kan je daar uiteraard een heel simpel voorbeeld plaatsen.
 
De excel cellen worden inderdaad veranderd van opmaak, niet alleen de cellen waar ik de waardes laat wegschrijven, maar ook vele andere cellen die van de opmaak "Tekst" worden veranderd naar de opmaak "Datum". Ik ga me best doen om een voorbeeld te maken en zo snel mogelijk te plaatsen
 
Ik ben even stap voor stap het gehele script doorgelopen. Ik heb gevonden waar het fout loopt, alleen snap ik het niet helemaal.
Ik heb in mijn bestand de onderstaande code staan ( heb ik gevonden op internet en gebruik ik in en ander userform voor het berekenen van pasen en van daaruit alle vakantiedagen etc. )
Code: 
Function Paasdag(jaar As Integer) As Date
    
    A = jaar Mod 19
    b = Fix(jaar / 100)
    C = jaar Mod 100
    d = Fix(b / 4)
    e = b Mod 4
    g = Fix((8 * b + 13) / 25)
    theta = Fix((11 * (b - d - g) - 4) / 30)
    Phi = Fix((7 * A + theta + 6) / 11)
    psi = (19 * A + (b - d - g) + 15 - Phi) Mod 29
    i = Fix(C / 4)
    k = C Mod 4
    lamda = ((32 + 2 * e) + 2 * i - k - psi) Mod 7
    maand = Fix((90 + (psi + lamda)) / 25)
    Dag = (19 + (psi + lamda) + maand) Mod 32
    
    Paasdag = DateValue(Dag & "-" & maand & "-" & jaar)

End Function

Nadat het userform de data uit access heeft geïmporteerd slaat automatisch de bovenstaande code aan ( waarom snap ik ook niet helemaal ). Nadat de bovenstaande code is doorlopen wordt de opmaak van diverse cellen op diverse sheets van excel veranderd.
Ik snap totaal niet waarom dit gebeurt en hoe ik dit zou kunnen oplossen. Ik zit momenteel vele gemaakte userforms te testen en steeds kom ik terug op dit probleem wat door bovenstaande script op de ene of andere manier wordt gecreëerd.
 
tussendoor nog meer getest, de functie genoemd in #12 eruit gehaald maar het probleem blijft bestaan. Nadat ik access heb benaderd om de data naar excel te importeren laat ik de data wegschrijven naar en tabblad dmv
Code: 
Sheet8.Range("A3").CopyFromRecordset rs
en direct wordt de opmaak veranderd.
 
Je plaatst een datumwaarde, dan is het toch logisch dat er een datumwaarde komt te staan?
Wijzig:
Function Paasdag(jaar As Integer) As Date

Eens in dit:
Function Paasdag(jaar As Integer) As String
 
Beste Edmoor,
Als eerste bedankt voor uw meedenken en uw reacties op mijn vervelende probleem.

Zoals ik #12 geschreven heb ik deze functie compleet weggehaald. Nu gebeurt alsnog dat de opmaak van de cellen in offsheet1 worden veranderd van "tekst" naar "datum" moment dat de data uit acces naar een 2e tabblad (sheet8) wordt weggeschreven. De data zijn alle klantgegevens, naam, adres etc. dus niet alleen een datum of iets

Zou ik desbetreffende data uit het access bestand direct in de listbox kunnen krijgen zonder het weg te laten schrijven naar een tabblad? Misschien kan ik zo dit probleem omzeilen.
 
Ik zie nog steeds geen voorbeeld document waarin je probleem speelt, zo blijven we speculeren.
 
Beste Edmoor,

Onderstaand het voorbeeld bestand. Ik heb een voorbeeldbestand van de database klaarstaan maar deze kan ik helaas niet uploaden, hier geeft hij een foutmelding op. Bekijk bijlage Vead - voorbeeld.xlsm
Met het importeren van de data gaat het ergens fout, misschien in de benadering van de database en het wegschrijven naar het gewenste sheet. Moment dat de data uit het access bestand wordt geïmporteerd en weggeschreven naar sheet8 wordt de opmaak op offsheet1 veranderd.

Ik heb opgemerkt hoe meer data er in de database staat hoe meer regels de opmaak wordt veranderd, b.v. een regel of 20 in de database, dan wordt de opmaak van de cellen C3 t/m C22 veranderd van tekst naar datum.

Is er anders niet een mogelijkheid om dit alles te omzeilen en dat ik de gewenste data direct vanuit access kan uploaden in de listbox in excel?
 
Ik probeer dit probleem momenteel anders aan te pakken, ik heb nu iets gevonden waardoor ik alle data vanuit access direct laat uploaden in me gewenste listbox dmv het rode in de onderstaande code.

Code: 
Sub ImportObjectenBestand(var) ''Importeren van klantenbestand vanuit Acces
''ClearsheetImportklant ''"ImportKlnt"

On Error GoTo Errhandler:
Application.ScreenUpdating = False
dbpath = DataSheet.Cells(7, 8).Value
''dbpath = "192.168.1.240\VanEijk\Offertes\VanEijkTest.accdb"
''dbpath = "Z:\VanEijk\Offertes\VanEijk.accdb"
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath
Sql = "SELECT * FROM ProjectenDb WHERE Id LIKE '" & var & "%" & "'"
Set rs = New ADODB.Recordset
rs.Open Sql, cnn
If rs.EOF And rs.BOF Then
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Application.ScreenUpdating = True
''MsgBox "Kan de klantendatabase niet vinden.", vbCritical, "Geen database gevonden"
Exit Sub
End If
[COLOR="#FF0000"]
With Me.ListBox1
.ColumnCount = rs.Fields.Count
.Column = rs.GetRows
.ColumnWidths = "0;0;0;100;0;0;0;75;0;0;0;0;0;0;0;0;0;0;0;0;0"
End With
rs.MoveFirst[/COLOR]
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
On Error GoTo 0
Exit Sub
Errhandler:
Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Importeren van personeelsdata"
End Sub

Ik ben nu alleen tegen 2 andere problemen opgelopen waar ik een beetje hulp bij nodig heb.

1. ik zou graag de gewenste data eerst laten sorteren op alfabetische volgorde. De data zou ik graag gesorteerd willen hebben op de kolom "Zoeknaam" zoals deze in de access database heet.
2. Ik heb een zoekroutine in het userform staan. Deze zou moeten zoeken in de listbox zelf. Omdat de data nu momenteel anders wordt ingeladen in de listbox veranderd ook de zoekroutine hiervan. In onderstaande code staat de manier zoals ik de gegevens opzocht, in het rood geeft hij nu een foutmelding. Dit snap ik omdat de data anders wordt ingeladen niet meer dmv listbox1.list = Myarray, ik weet alleen helaas niet de oplossing hiervoor.

Code: 
Private Sub txtzoek_Afterupdate()
sFind = txtzoek.Text
If Len(sFind) = 0 Then
ListBox1.ListIndex = -1
ListBox1.TopIndex = 0
Else
For i = 0 To ListBox1.ListCount - 1
For j = 0 To ListBox1.ColumnCount
[COLOR="#FF0000"]If InStr(UCase(ListBox1.List(i, j)), UCase(sFind)) > 0 Then[/COLOR]

ListBox1.TopIndex = i
ListBox1.ListIndex = i
End If
Next j
Next i
End If
End Sub
 
Wat wil je nu eigenlijk en wat is het probleem? Alle code die je gebruikt zal geminimaliseerd kunnen worden tot een paar regels. Waarom plaats je de Access database niet. En nee niet de hele maar alleen een voorbeeld ervan met wat relevant is?
 
Het probleem is momenteel anders als in 1ste instantie. Het begon dat de opmaak van diverse sheets werd veranderd van "tekst" naar de opmaak "datum", nadat het scrip de volgende regel had geactiveerd:
Sheet8.Range("a3").CopyFromRecordset rs

Nu wil ik dat proberen te voorkomen, dit kan uiteraard veel problemen geven.
Ik heb vanmiddag dus nog zitten zoeken en heb op internet een code gevonden om de data direct in de listbox van het userform wordt geladen. Deze staat bij de 1ste code bij #18 genoemd in het rood.

Dit gaf mij de volgende problemen waar ik graag hulp bij wil hebben:

* de data die ik importeerde, liet ik sorteren op alfabetische volgorde aan waardes van de 4e kolom. Maar aangezien dit direct in de listbox wordt geladen op manier die ik nog niet helemaal snap krijg ik het niet op gesorteerd.

* De zoekfunctie die ik in het userform heb staan die werkt niet meer doordat de data anders in de listbox wordt ingeladen als voorheen op een manier die ik nog niet helemaal snap.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan