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

VBA code

  • Onderwerp starter Onderwerp starter thst
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
thst

thst

Gebruiker
Lid geworden
10 apr 2001
Berichten
655
Met deze topic zal ik hoogstwaarschijndelijk veel reacties krijgen, maar ik heb er nog nooit meegewerkt dus begin ik er maar eens aan.

Hallo VBA ers,

Ik heb een VBA code en weet niet hoe ik die in mijn sheet moet intregeren.
Maar allereerst zou de VBA code aangepast moeten worden naar mijn omstandigheden.

Het voorbeeld bestandje werkt met 2 postcodes, in mijn geval gaat het om 4 postcodes of 5 postcodes.

Mijn sheet heet Facturen en in P16, P17, P18, P19, P20 staan postcodes
Als P7 = "" P16, P17, P18, P19 anders P16, P17, P18, P19, P20

De kilometers in mijn sheet komen dan te staan in M21

Wat doet de VBA code ?

Je vult in B2 en in B3 een postcode in, klikt op de button en de kilometers en reistijd komen respectivelijk in B5 en B6 terecht.

Angela
 

Bijlagen

Verander de regel code in dit
Code: 
Worksheets(1).[M21] = strDistance
 
Openstaande berichten

voordat je allemaal nieuwe vragen gaat stellen, zouden medeforum gebruikers, het op prijs stellen als je de openstaande vragen afsluit (of in ieder geval dat je als laatste poster staat).

Dit staat in ieder geval wel netjes naar de medeforumleden.

Als deze vragen niet zijn opgelost, ga daar dan eerst nog eens mee aan de slag.

heb dit verzoek in het verleden al eens aan jou gedaan!! :(

Welke staan in ieder geval nog (recent) open:

26-01-2010
28-01-2010
01-02-2010

Doe jezelf een plezier en doe er iets mee.

Met vriendelijke groeten,

Oeldere
 
Beste Oeldere,

Kan ik ergens in het forum zien welke vragen er nog openstaan van mij.
Inderdaad ik vind het ook erg vervelend als er nog vragen openstaan, en ik al de oplossing gekregen heb of mede dank zij tips zelf op een idee ben gekomen.

Angela
 
Klik op "Directe links", dan "Profiel", dan "Statistieken", dan "Zoek alle vragen die gestart zijn door thst".
 
Beste thst ;)

25 topics van de 69 die door U aangemaakt zijn zijn niet op opgelost gezet :D:p

Groetjes Danny. :thumb:
 
Ja ik ben er mee bezig om alles na te kijken en of op opgelost te zetten.

Ik kan alleen nog niet in een oog opslag zien welke topics er nog open staan.

Angela
 
Oke, ik begrijp dus dat dit topic gaat over het sluiten van mijn opengestelde topics.

Angela
 
Even terug te komen op #1
heb nu de code verandert zodat deze met 4 postcodes kan werken.

strLink = "http://maps.google.nl/maps?f=d&source=s_d&saddr=" & strvanstraat & "&daddr=" & strnaar1straat & "+to:" & strnaar2straat & "+to:" & strnaar3straat & "&hl=nl&geocode=&mra=ls&sll=51.238135,5.69546&sspn=0.121661,0.356712&ie=UTF8&z=12"

wie geeft mij de oplossing voor de andere opties die ik in #1 gevraagt heb.

Angela
 
Beste thst ;)

Kijk eens naar deze topic

Ik zie dat je al een paar topics hebt opgelost, maar er staan er nog altijd 23 niet op opgelost.
Vanaf 1 sep 2005 tot 30 sep 2008 later is allemaal opgelost.

Groetjes Danny. :thumb:
 
In een topic van 24 jan 2010 zette ik een jpeg met Belgische postnummers dit kan ook met Nederlandse postnummers , echter was de TS in die topic iemand anders die der niet naar vroeg .
Wat dacht je van deze code die achter het tabblad van de jpeg staat :eek:
Code: 
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliseconds As Long)

Private Sub CommandButton1_Click()

Dim objExplorer As Object
Set objExplorer = CreateObject("InternetExplorer.Application")

With Range("Adressen")
    caintRow = .Rows.Count
    strnaarplaats = Trim(.Cells(1, 1))
    strnaarpostcode = Trim(.Cells(1, 2))
    strnaarland = Trim(.Cells(1, 3))
    For iaintRow = 2 To caintRow
            strvanplaats = strnaarplaats
            strvanpostcode = strnaarpostcode
            strvanland = strnaarland
            If .Cells(iaintRow, 1) <> vbNullString Then
                strnaarplaats = Trim(.Cells(iaintRow, 1))
                strnaarpostcode = Trim(.Cells(iaintRow, 2))
                strnaarland = Trim(.Cells(iaintRow, 3))
                strLink = "http://maps.google.nl/maps?f=d&source=s_d&saddr=" & strvanplaats & "+" & strvanpostcode & "+" & strvanland & "&daddr=" & strnaarplaats & "+" & strnaarpostcode & "+" & strnaarland & "&hl=nl&geocode=&mra=ls&sll=51.238135,5.69546&sspn=0.121661,0.356712&ie=UTF8&z=12"
                objExplorer.navigate (strLink)
                objExplorer.Visible = True
                Do While objExplorer.Busy Or objExplorer.readystate <> 4 'aanpassing 3
                    DoEvents
                    Sleep 500 'aanpassing 3
                Loop
                strSearchedIn = objExplorer.document.body.innerhtml
                intPosition1 = InStr(1, strSearchedIn, "Bedoelde u:")
                If intPosition1 <> 0 Then
                    Range("Traject").Cells(iaintRow, 1) = "Adresfout"
                Else
                    strSearchedFor1 = "Routebeschrijving naar"
                    intPosition1 = InStr(1, strSearchedIn, strSearchedFor1)
                    strSearchedFor2 = "<DIV><B>"
                    intPosition2 = InStr(intPosition1, strSearchedIn, strSearchedFor2) + Len(strSearchedFor2)
                    strSearchedFor3 = "</B>"
                    intPosition3 = InStr(intPosition2, strSearchedIn, strSearchedFor3)
                    strAfstand = Replace(Mid(strSearchedIn, intPosition2, intPosition3 - intPosition2), "&nbsp;km", "")
                    dblAfstand = CDbl(strAfstand)
                    Range("Traject").Cells(iaintRow, 1) = dblAfstand
                End If
            End If
    Next iaintRow
End With

With Range("Adressen")
    caintRow = .Rows.Count
    strvanplaats = Trim(.Cells(1, 1))
    strvanpostcode = Trim(.Cells(1, 2))
    strvanland = Trim(.Cells(1, 3))
    For iaintRow = 2 To caintRow
        If .Cells(iaintRow, 1) <> vbNullString Then
            strnaarplaats = Trim(.Cells(iaintRow, 1))
            strnaarpostcode = Trim(.Cells(iaintRow, 2))
            strnaarland = Trim(.Cells(iaintRow, 3))
            strLink = "http://maps.google.nl/maps?f=d&source=s_d&saddr=" & strvanplaats & "+" & strvanpostcode & "+" & strvanland & "&daddr=" & strnaarplaats & "+" & strnaarpostcode & "+" & strnaarland & "&hl=nl&geocode=&mra=ls&sll=51.238135,5.69546&sspn=0.121661,0.356712&ie=UTF8&z=12"
            objExplorer.navigate (strLink)
            objExplorer.Visible = True
            Do While objExplorer.Busy Or objExplorer.readystate <> 4 'aanpassing 3
                DoEvents
                Sleep 500 'aanpassing 3
            Loop
            strSearchedIn = objExplorer.document.body.innerhtml
            intPosition1 = InStr(1, strSearchedIn, "Bedoelde u:")
            If intPosition1 <> 0 Then
                Range("Traject").Cells(iaintRow, 1) = "Adresfout"
                Range("Theoretische_afstand").Cells(iaintRow, 1) = "Adresfout"
            Else
                strSearchedFor1 = "Routebeschrijving naar"
                intPosition1 = InStr(1, strSearchedIn, strSearchedFor1)
                strSearchedFor2 = "<DIV><B>"
                intPosition2 = InStr(intPosition1, strSearchedIn, strSearchedFor2) + Len(strSearchedFor2)
                strSearchedFor3 = "</B>"
                intPosition3 = InStr(intPosition2, strSearchedIn, strSearchedFor3)
                strAfstand = Replace(Mid(strSearchedIn, intPosition2, intPosition3 - intPosition2), "&nbsp;km", "")
                dblAfstand = CDbl(strAfstand)
                Range("Theoretische_afstand").Cells(iaintRow, 1) = dblAfstand
            End If
        End If
    Next iaintRow
End With

objExplorer.Quit
Set objExplorer = Nothing

End Sub

Als je niet wil dat google de diverse kaarten laat zien schakel je deze uit door
Code: 
objExplorer.Visible = True
te wijzigen in
Code: 
objExplorer.Visible = False
Dit staat er 2maal in !
 

Bijlagen

  • googlemaps.jpg
    googlemaps.jpg
    63 KB · Weergaven: 62
Laatst bewerkt:
Beste Trucker10 ;)

Als ik me niet vergis heb je toen een bestandje toegevoegd maar het was beveiligd.
Kan je het hier nog eens plaatsen zonder beveiliging.
Dank U.

Groetjes Danny. :thumb:
 
Hallo Allemaal,

Graag zou ik willen weten hoe ik een melding in mijn VBA code kan krijgen als de postcode niet bestaat.

Private Sub CommandButton1_Click()

strvanpc = Worksheets(6).Cells(16, 16)
strvanplaats = Worksheets(6).Cells(14, 1)
strnaar1pc = Worksheets(6).Cells(17, 16)
strnaar1plaats = Worksheets(6).Cells(15, 1)
strnaar2pc = Worksheets(6).Cells(18, 16)
strnaar2plaats = Worksheets(6).Cells(16, 1)
strnaar3pc = Worksheets(6).Cells(19, 16)
strnaar3plaats = Worksheets(6).Cells(17, 1)

strLink = "http://maps.google.nl/maps?f=d&source=s_d&saddr=" & strvanpc & "+" & strvanplaats & "&daddr=" & strnaar1pc & "+" & strnaar1plaats & "+to:" & strnaar2pc & "+" & strnaar2plaats & "+to:" & strnaar3pc & "+" & strnaar3plaats & "&hl=nl&geocode=&mra=ls&sll=51.238135,5.69546&sspn=0.121661,0.356712&ie=UTF8&z=12"
''ActiveWorkbook.FollowHyperlink (strLink), , True

Als de postcodes wel bestaan, plaatst de code het aantal kilomters in;
Worksheets(6).Cells(21, 13) = strDistance

Verder worden de kilometers weergegeven als 234km
Graag wil ik dat de kilometers zonder km worden weergegeven.

De melding als de postcode niet bestaat weergeven op de plaats van klometers, postcode onbekend.

Angela
 
Code: 
Worksheets(6).Cells(21, 13) = Replace(strDistance, "km", "")
 
Zou het ook nog een afgerond getal kunnen zijn ?

Angela
 
De kilometers kunnen ook aangegeven worden als:
234,7km graag zou ik zien dat het wordt afgerond, dus in dit geval dat er 235 komt te staan.

Angela
 
Als je niet weet hoe je moet afronden in VBA zou ik eerst maar eens grondig en basaal met de beginselen van VBA beginnen aan de hand van een goed boek.
 
Als jezelf niet weet hoe de afronding in VBA moet, geef dan geen commentaar op een ander.
En anders geef gewoon antwoordt op mijn vraag, of reageer helemaal niet !!


Angela
 
Ik zou er toch maar eens enkele posts van snb op nalezen alvorens zulke (domme) opmerking te maken.
Hieronder enkele mogelijkheden
Code: 
Sub tst()
[b1] = Int([a1])
[c1] = Fix([a1])
[d1] = Application.WorksheetFunction.RoundUp([a1].Value, 0)
[e1] = Application.WorksheetFunction.RoundDown([a1].Value, 0)
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan