Menu Content/Inhalt
DIN1055.de arrow Software arrow Windbereiche
Office steuert Google Earth: Excel/VBA als Fernbedienung
vba_geDas Programm Google Earth (GE) erfreut sich immer größerer Beliebtheit. Es kann auch im Bauwesen sinnvoll eingesetzt werden. So zeigt die kostenlose Basis-Variante Geländehöhen an, die sich u. a. für die Berechnung der Schneelast nutzen lassen. Für den häufigen Gebrauch lässt sich GE "von außen" bedienen: Das Anfliegen eines Ortes findet automatisiert statt.

Google Earth mit VBA ansteuern

Die Seite Access im Unternehmen veröffentlicht einen ausgezeichneten, anschaulichen und ausführlichen Beitrag, wie sich GE sinnvoll in Access einbinden lässt. Dort finden Sie auch weiterführende links zu diesem Themengebiet. Auf DIN1055.de zeigen wir lediglich eine abgespeckte Quick-And-Dirty-Variante, die sich in unseren Excel-basierten SchneeLastRechner integrieren lässt.

Bitte beachten Sie hierzu auch unseren Artikel zum Browseraufruf aus Excel.

Wenn Sie den Code in unsere UserForm 'frmSchnee' kopieren (bestehenden Code auskommentieren) und den Button Höhe ü. NN in m (benannt mit 'cmdHoehe') klicken, startet Google Earth automatisch und fokusiert den vorab eingegebenen Bauort.

CODE:
Private Sub cmdHoehe_Click()
    'ruft Google-Earth auf
    SchneeGE "Kolonnenstr. 30 L, 10829 Berlin" '[Strasse Nr, PLZ ]Ort
End Sub

Private Sub SchneeGE(Optional ByVal strOrt As String)

'Ruft Google Earth auf und listet strOrt im Suchbereich
' VBA-Entwicklungsumgebung (VDE), Menü Extras - Verweise - "Earth 1.0 Type Library" zuschalten!
' siehe auch: Google Earth ferngesteuert
' ACHTUNG: Es erfolgt keine Prüfung oder Fehlerbehandlung, falls GE nicht installiert ist. In
' der Ur-Fassung wird DIESE Sub über einen Button aus Excel heraus gestartet, der Aufruf über
' eine andere Routine o. ä. lässt sich flexibel gestalten.
'
' Ein aktiver Internetzugang und eine vorhandene "Google Earth"-Installation werden vorausgesetzt.

Dim objGE As Object     'die Anwendung Google Earth (GE)
Dim objSC As Object     'SearchControllerGE (Suchfeld von GE)
Dim objFC As Object     'Suchergebnisse
Dim i As Integer
'Änderung von "AutoPilotSpeed": Einfluss nicht bestätigt --> selbst testen / auskommentieren
Dim dblAPo As Double    'Wert der in GE eingestellten Anflug-Geschwindigkeit des AutoPiloten

    Set objGE = CreateObject("GoogleEarth.ApplicationGE")
         
    With objGE
    Do                                  'Prüfen, ob GE geöffnet, verfügbar, online, nicht busy
        DoEvents                        ' .isonline beim Testen Offline auskommentieren!
    Loop Until .IsInitialized = 1 And .IsOnline = 1 And .SearchController.IsSearchInProgress = 0
    End With

    'Änderung von "AutoPilotSpeed": Einfluss nicht bestätigt --> selbst testen / auskommentieren
    dblAPo = objGE.AutoPilotSpeed       'Original-Anfluggeschwindigkeit auslesen
    objGE.AutoPilotSpeed = 5            'überschreiben: 5 = Maximum!
   
    Set objSC = CreateObject("GoogleEarth.SearchcontrollerGE")
    objSC.ClearResults                  'Verklauf leeren
    Application.Wait (Now + TimeValue("0:00:01")) 'Verzögerung erzwingt anfliegen?!
    'steuert Anfluggeschwindigkeit - Reihenfolge NICHT verändern: AutoPilot --> Search
    objSC.Search strOrt
    Do
        DoEvents
    Loop Until objSC.IsSearchInProgress = 0
   
    Set objFC = objSC.GetResults        'Suchergebnisse von GE abfragen
    If objFC.Count > 0 Then             'Falls mehrere Treffer: Auflisten
        If InStr(1, objFC(1).Name, "Meinten Sie") <> 0 Then
            Set objFC = objFC(1).GetChildren
            For i = 1 To objFC.Count
                Debug.Print objFC(i).Name
            Next i
            strOrt = Chr$(objFC.Count) & "Nicht eindeutig"
        Else                            'Falls EIN Treffer: Anzeigen
            strOrt = objFC(1).Name
            objFC.Item(1).Highlight
        End If
    End If

    'Änderung von "AutoPilotSpeed": Einfluss nicht bestätigt --> selbst testen / auskommentieren
    objGE.AutoPilotSpeed = dblAPo       'Original-Anfluggeschwindigkeit wiederherstellen
   
    Set objGE = Nothing                 'Speicherplatz freigeben
    Set objSC = Nothing

End Sub

Bei Fragen und Anmerkungen wenden Sie sich bitte per E-Mail an Diese E-Mail Adresse ist gegen Spam Bots geschützt, Sie müssen Javascript aktivieren, damit Sie es sehen können
» Keine Kommentare
Es gibt bisher noch keine Kommentare.
» Kommentar schreiben
Nur registrierte Benutzer können Kommentare schreiben. Bitte melden Sie sich an oder registrieren Sie sich ('Anmelden' im Hauptmenü).
 
< zurück   weiter >
designed by www.madeyourweb.com