Tag: excel

irgendwo im netz gefunden. immer wieder gebraucht. hier nochmal festgehalten.

blattschutz entfernen:

– vb editor oeffnen (alt+f11)
– neues modul in die arbeitsmappe einfuegen

dann diesen code einfuegen:

Sub SchutzEntfernen()
On Error Resume Next
For i = 65 To 66: For j = 65 To 66
For k = 65 To 66: For l = 65 To 66
For m = 65 To 66: For n = 65 To 66
For o = 65 To 66: For p = 65 To 66
For q = 65 To 66: For r = 65 To 66
For s = 65 To 66: For t = 32 To 126
ActiveSheet.Unprotect Chr(i) & _
Chr(j) & Chr(k) & Chr(l) & _
Chr(m) & Chr(n) & Chr(o) & _
Chr(p) & Chr(q) & Chr(r) & _
Chr(s) & Chr(t)
Next t: Next s: Next r: Next q
Next p: Next o: Next n: Next m
Next l: Next k: Next j: Next i
MsgBox "Schutz abgeschaltet"
End Sub

– vb editor schliessen
– mit alt+f8 modul auswaehlen und ausfuehren.

aehnlich geht das mit dem kennwort auf die komplette arbeitsmappe… gleiches vorgehen, nur statt “ActiveSheet.Unprotect” ein:

ActiveWorkbook.Unprotect Chr(i) & _

notiz… damit ich das nicht nochmal erfinden muss. die webseite erfordert ein login, bevor man daten runterladen kann. das login formular muss man sich halt mal ansehen und die entsprechenden werte in einem POST request schicken. ich habe dazu einfach irgendein firefox plugin beim login mitlaufen lassen, welches den entsprechenden POST request aufzeichnet. das cookie muss man dann noch aus der antwort des webserver axtrahieren und beim anschliessenden download der dateien mitschicken.
mit excel 2003 und dem ie7 ging das noch ohne login in vba, wenn man sich vorher im browser eingeloggt hatte (mit urlmon o.ä. einfach runterladen). mit excel 2010 und ie9 muss man sich explizit (mit vba) einloggen um die dateien runterladen zu können.

Option Explicit
 
Sub DownloadData()
 
    Dim strSavePath As String
    Dim strURL As String
    Dim strURLDownload As String
    Dim strHeaders As String
    Dim strResult As String
    Dim strRequest As Variant
    Dim objXMLhttp: Set objXMLhttp = CreateObject("msxml2.xmlhttp")
    Dim strUsername As String
    Dim strPassword As String
    Dim strFileToSave As String
    Dim xArr As Variant
    Dim yArr As Variant
    Dim strTheCookie As String
    Dim strCookie As String
    Dim objStream: Set objStream = CreateObject("ADODB.Stream")
    Dim i
    Dim WkSh As Worksheet ' das Quell-Tabellenblatt - die Herkunft der Daten
    Dim lZeile As Long
 
    ' Variablen
    Set WkSh = ThisWorkbook.Worksheets("DOWNLOADFILES") ' den Tabellenblattnamen ggf. anpassen!
    ' Format in dem Tabellenblatt DOWNLOADFILES.. einfach eine Auflistung der Download URLs:
    'http://www.website.com/download/data/file_1.xls
    'http://www.website.com/download/data/file_2.xls
    'http://www.website.com/download/data/file_3.xls

    ' Pfad zum speichern der XLS Dateien 
    strSavePath = "c:\temp\"
    strUsername = "vorname.nachname%40domain.tld" ' URL encoded: @ = %40
    strPassword = "mypassword"
    ' Login URL
    strURL = "http://www.website.com/login-user"
    ' mitgehörter request header (mit Firefox Plugin aufgezeichnet)
    ' Benutzername und Passwort durch Variablen ersetzt
    strRequest = "viewFrom=viewLOGIN&forward=%2Fbackend%2Findex.html&referer=%2Flogin.html&username= " & strUsername & "&password=" & strPassword & "&actionSUBMIT.x=0&actionSUBMIT.y=0"

    ' Login
    With objXMLhttp
        .Open "POST", strURL, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send strRequest
    End With
   
    strHeaders = objXMLhttp.getAllResponseHeaders()
   
    ' ggf Response speichern um das Cookie anzuschauen
    'Open "C:\temp\response.txt" For Output As #1
    '  Print #1, , strHeaders
    'Close
   
    ' Beispiel Cookie aus strHeaders
    'Set-Cookie: BALANCERID=b.cocoon0a0815; Expires=Tue, 07-Aug-2012 08:00:00 GMT; Path=/
   
    ' Cookie extrahieren
    xArr = Split(strHeaders, "Set-Cookie: ")
    For i = 1 To UBound(xArr)
        strTheCookie = Left(xArr(i), InStr(xArr(i), "Path=/") - 2)
        strCookie = strCookie & " " & strTheCookie
    Next
    yArr = Split(strCookie, ";")
    strCookie = yArr(0)
 
   For lZeile = 1 To WkSh.Cells(Rows.Count, 1).End(xlUp).Row

        ' Downloadlink
        strURLDownload = WkSh.Range("A" & lZeile).Value

        ' Dateiname aus URL extrahieren
        strFileToSave = Mid$(strURLDownload, InStrRev(strURLDownload, "/") + 1)
       
        ' Download der xls Datei
        With objXMLhttp
            .Open "GET", strURLDownload, False
            .setRequestHeader "cache-control", "no-cache, must revalidate"
            'Cookie 2mal setzen... Bug: http://support.microsoft.com/kb/290899
            .setRequestHeader "Cookie", strCookie
            .setRequestHeader "Cookie", strCookie
            .send
        End With
       
        ' Speichern der xls Datei als Binary
        With objStream
            .Type = 1 ' adTypeBinary
            .Open
            .Write objXMLhttp.responseBody
            .SaveToFile strSavePath & strFileToSave, 2 ' adSaveCreateOverWrite
        End With
        objStream.Close
       
   Next lZeile
   
    Set objStream = Nothing
    Set objXMLhttp = Nothing
 
End Sub
 

vor langer zeit hab ich schonmal einmal einen kalender mit bedingten formatierungen in excel gebastelt. jetzt habe ich das mal mit vba gemacht… that’s it (eine von 100000 moeglichkeiten in quick & dirty):

Option Explicit

Sub Kalender()
   
    'Variablen deklarieren
    Dim MyStartDate As Date
    Dim MyEndDate As Date
    Dim MyTempDate As Date
    Dim OffsetX As Integer
    Dim OffsetY As Integer
    Dim BGWE As Integer
    Dim BGKW1 As Integer
    Dim BGKW2 As Integer
    Dim MyTempKW As Integer
    Dim Zähler As Integer
    Dim MyWorksheet As String
    Dim KWBackgrund As Integer
    Dim MyHeadLine As Variant
    Dim i As Integer

    'Start- und Endedatum setzen; möglich mit verschiedenen Schreibweisen
    MyStartDate = "01. Mai 2012"
    MyEndDate = "31.01.2014"
    'Tabellenblatt für den Kalender
    MyWorksheet = "Tabelle1"
    'in welcher Zeile soll der Kalender beginnen?
    OffsetY = 1
    'in welcher Spalte soll der Kalender beginnen?
    OffsetX = 1
    'Hintergrundfarbe für Wochenende
    BGWE = 15
    'Hintergrundfarbe für KW im Wechsel
    BGKW1 = 0
    BGKW2 = 16
    'Überschriften
    MyHeadLine = Array("Datum", "Tag", "KW")
    
    'Inhalt aller Zeilen löschen
    Rows("1:65536").ClearContents
    'Alle Formatierungen löschen
    Cells.ClearFormats

    'Überschriften
    For i = 0 To UBound(MyHeadLine)
        Worksheets(MyWorksheet).Cells(OffsetY, OffsetX + i).Value = MyHeadLine(i)
        Worksheets(MyWorksheet).Cells(OffsetY, OffsetX + i).Font.FontStyle = "Fett"
    Next
      
    
    'Kalender ausgeben
    For Zähler = 0 To DateDiff("d", MyStartDate, MyEndDate)
    
        MyTempDate = DateAdd("d", Zähler, MyStartDate)
        
        'Wochenende grau Markieren
        If Format(MyTempDate, "DDD") = "Sa" Or Format(MyTempDate, "DDD") = "So" Then
            Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX + 1).Interior.ColorIndex = BGWE
        End If
        
        'Farbwechsel für die KW
        KWBackgrund = IIf(kw_nach_din(MyTempDate) And 1, BGKW1, BGKW2)
        Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX + 2).Interior.ColorIndex = KWBackgrund

        'aktuellen Tag rot Markieren
        If MyTempDate = Date Then
            Worksheets(MyWorksheet).Range(Cells(1 + Zähler + OffsetY, OffsetX), Cells(1 + Zähler + OffsetY, OffsetX + 2)).Interior.Color = vbRed
        End If
        
        'erste Spalte mit Datum
        Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX).Value = MyTempDate
        
        'zweite Spalte mit Wochentag
        Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX + 1).Value = Format(MyTempDate, "DDD")
        
        'dritte Spalte mir KW (aber nur am ersten Tag der KW ausgeben)
        If MyTempKW <> kw_nach_din(MyTempDate) Then
            Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX + 2).Value = kw_nach_din(MyTempDate)
            MyTempKW = kw_nach_din(MyTempDate)
        End If
        
    Next Zähler
    
End Sub


Function kw_nach_din(datum As Date) As Byte
 Dim kw As Date
 kw = 4 + datum - Weekday(datum, 2)
 kw_nach_din = (kw - DateSerial(Year(kw), 1, -6)) \ 7
End Function

das ergebnis ist vergleichbar mit dem von damals:

vba und die variablendeklaration… au weia. diese fehlermeldung kommt sicher jedem mal unter, der sich etwas mit vba beschaeftigt.

so hat man das mal gelernt mit der mehrfachdeklaration von variablen:

'Variablen deklarieren
Dim MyStartDate, MyEndDate, MyTempDate, MyDate As Date

nun z.b. eine funktion, welche als uebergabeparameter ein datum erwartet. wenn man dieser funktion nun die mit einem datum befuellten variable “MyTempDate” uebergibt, bekommt man die oben abgebildete fehlermeldung. und warum?

dazu muss man wissen, dass vb alle variablen, die nicht explizit mit einem bestimmten datentyp deklariert wurden, als “variant” deklariert. das tolle deklarieren von mehreren variablen in einer zeile funktioniert naemlich garnicht! dann hat ist der typ der o.g. variable “MyTempDate” naemlich “variant”.
um dem problem aus dem weg zu gehen, sollte man einfach alle variablen einzeln deklarieren. ist mehr arbeit, braucht mehr platz… aber funktioniert.

'Variablen deklarieren
Dim MyStartDate As Date
Dim MyEndDate  As Date
Dim MyTempDate As Date
Dim MyDate As Date