Category Archives: VBA

VBA-esimerkkejä

Kansiossa olevien tiedostojen luku VBA:ssa

VBA:ssa voit lukea kansion Dir käskyllä löytääksesi haluamasi tiedoston tai vaikka kansion kaikki tiedostot.

Käytä lukemisessa Do While – Loop solmukkaa. Kun olet käsitellyt tiedoston ja haluat lukea seuraavan tiedoston suorita Dir toistamiseen ennen Loop käskyä.

Alla olevassa esimerkissä kansionkin voisi parametrisoida ja Sub:n muuttaa Function proseduuriksi.

 

Sub EtsiTiedosto()

Dim NextBook As String

NextBook = Dir(“c:\test\*.xlsx”)     ‘lue hakemistosta kaikki .xlsx tiedostot

Do While NextBook <> “”     ‘silmukka niin kauan kun tiedostoja löytyy

    Koodi joka käsittelee löydetyn tiedoston


 

NextBook = Dir()         ‘lue hakemisto uudestaan

Loop

End Sub

Vauhtia makroon

Nopeampaa makro suoritusta Excelissä.

Muutamalla perusasetuksella saa koodin toimimaan nopeammin.
Tietenkin tekemällä hyvää ja lyhyttä koodia ja välttelemällä turhia soluvalintoja selectillä mutta on myös pari peruslaatua olevaa komento jolla saadaan vaihtua ohjelmaan.

Ensinnäkin näytön päivitys pois
Application.ScreenUpdating = False
ja takasin päälle silloin kun tarvitaan
Application.ScreenUpdating = True

Laskenta pois päältä
Application.Calculation = xlCalculationManual
ja takaisin päälle
Application.Calculation = xlCalculationAutomatic

Tapahtumahallinta pois päältä
Application.EnableEvents = False
ja takasin päälle
Application.EnableEvents = True

Sivukatkojen laskenta pois päältä
Activesheet.DisplayPageBreaks = False
ja takasin päälle
Activesheet.DisplayPageBreaks = True

Näytön päivitys on se mikä useimmiten puuttuu makroista. Kannatta kokeilla ainakin sitä. Jos lähdet asettamaan laskennan manuaaliseksi niin muista laittaa se päälle kun haluat että Excel taas laskee automaattisesti.

Muutama VBA-editorin asetus

Meille huononäköisille saadaan VBA-editorin fontti isommaksi kohdasta:
VBA – Editorin valikko: Tools – Options, Editor Format ja Size kohta.

Itse olen myös ottanut ponnahdusikkuna-ilmoituksen pois virheistä koodirivillä kohdasta Tools – Options, Editor, Auto Syntax Check.
Itselleni riittää kun rivi muuttuu punaiseksi, koen ponnahdusikkunan erittäin ärsyttäväksi.

Kannattaa myös laittaa päälle asetus Require Variable Declaration joka vaatii muuttujien määrittelyn ja laittaa uusien moduulien ensimmäiseksi riviksi Option Explicit.

 

Negatiiviset luvut nolliksi

Silloin tällöin on ollut tarvetta muuntaa kaikki negatiiviset arvot nolliksi (0).
Se voidaan tehdä esimerkiksi seuraavalla makrolla jos ensin valitaan asianomainen alue ja sitten suoritetaan makro:

Sub ChangeNegativeToZero()     
    Dim c As Range     
    For Each c In Selection
         If c.Value < 0 Then
             c.Value = 0
         End If     
    Next
End Sub

Voit kopioida makron työkirjaan seuraavasti:
Kopioi tämä makro leikepöydälle
Työkirjassa paina Alt+F11
Valitse VBA ikkunassa Insert – Module
Valitse Edit – Paste

Suorita makro:
Valitse alue taulussa jonka haluat muuttaa
Valitse View – Macros – View Macros (Näytä – Makrot – Näytä Makrot)
Valitse ikkunasta juuri liittämäsi makro ja napsauta Run (Suorita)

Poista PowerPoint 2013 linkit

PowerPointissa 2013 et pysty valitsemaan useita linkkejä samanaikaisesti ja poistaa niitä.
Siihen tarvitaan pieni VBA-koodi avuksi joka löytyy mm tältä sivustolta:

http://www.pptfaq.com/FAQ01172-Break-all-of-the-links-in-a-presentation.htm

Mikäli sivu ei aukeaisi niin ohessa koodi:

Sub BreakAllLinks()
    Dim oSld As Slide
    Dim oSh As Shape
    For Each oSld In ActivePresentation.Slides
           For Each oSh In oSld.Shapes
           If oSh.Type = msoLinkedOLEObject Then
                   oSh.LinkFormat.BreakLink
           End If
           Next   ' Shape
    Next   ' Slide
 End Sub

 

Ensimmäinen numero merkkijonossa

Oheisella funktiolla etsitään merkkijonon ensimmäinen numeropositio.
Esimerkiksi merkkijonoista abc123 tai a234, tai xyyz23 halutaan pomia teksti ja numerot erikseen. Merkkijono on vaihtelevan pituinen.
Kun ensimmäisen numeron postio tiedetään voidaan edelleen laskentataulussa funktioilla vasen (left), oikea (right), pituus (len) ja poimi.teksti (mid) poimia merkkijonosta tietoja.

Function FirstNumPos(code As String) As Long
    Dim lngLenght As Long
    Dim i As Long
    
    lngLenght = Len(code)
    For i = 1 To lngLenght
        If Mid(code, i) >= Chr(48) And Mid(code, i) <= Chr(57) Then
            FirstNumPos = i
            Exit Function
        End If
    Next
    FirstNumPos = 0
End Function

 

Kahden solun yhdistäminen

Yhdistetään A ja B sarakkeen solut ja laitetaan välilyönti väliin
Esim.:
Solussa A1 = Aku ja B1 = Ankka -> C1 = Aku Ankka
Funktioilla:
KETJUTA (CONCATENATE)
=KETJUTA(A1;” “;B1)
tai
=A1&” “&B1
(Välilyönti laitetaan kahden lainausmerkin väliin koska se on tekstiä kaavassa)

Makrolla voit tehdä sen esim. seuraavalla tavalla:

Sub Yhdista()
'ohjelma yhdistää A ja B sarakkeen solut C sarakkeeseen
 'lähdetään liikkeelle A1:stä (cells(1,1))
 'Cells parametreja muuttaen voidaan valita toinen lähtösolu ja
 'myös sarake jonne yhdistetty tulos laitetaan

Dim rwIndex As Long
Dim i As Long
'lasketaan täytettyjen solujen määrä A1:stä alaspäin
rwIndex = Sheets(1).Cells(1, 1).End(xlDown).Row
For i = 1 To rwIndex
     Cells(i, 3).Value = Cells(i, 1) & " " & Cells(i, 2)
Next
End Sub

 

 

Taulujen lajittelu työkirjassa

Silloin tällöin tulee tarve saada lajiteltua taulut aakkosjärjestykseen.
Sen voi tehdä seuraavalla makrolla:

Option Compare Text '( tarkoittaa että A = a)

Sub AakkostaTaulut()
Dim i As Long, j As Long, lngTaulujenMäärä As Long
    lngTaulujenMäärä = Sheets.Count
    On Error GoTo VirheH:
    For i = 1 To lngTaulujenMäärä – 1
        For j = i + 1 To lngTaulujenMäärä
            If Sheets(j).Name < Sheets(i).Name Then
                 Sheets(j).Move Before:=Sheets(i)
            End If
        Next
    Next
    Sheets(1).Select
VirheH:
End Sub

 

 

Makron nauhoitus

Muutama perusasia ennen kuin nauhoitat makron

  1. Pystytkö hoitamaan toiminnon funktioilla? (Toimii todennäköisesti varmemmin.)
  2. Harjoittele ensin kaikki vaiheet. (Nauhoitus nauhoittaa kaikki liikkeet, myös mokat).
  3. Pohdi, minkä solun valitset ennen nauhoitusta vai nauhoitatko soluvalinnan makroon.
  4. Muista soluvalinnat nauhoituksessa, ne nauhoittuvat soluviittauksin. Käytä tarvittaessa pikanäppäimiä.
  5. Muista lopettaa nauhoitus!

Esimerkki: Otsikkorivin lihavointi.

Asetatko ensin osoittimen soluun, josta valinta aloitetaan, vai aletaanko aina solusta A1?

Oletan tässä, että aloitetaan aina solusta A1, joten nauhoitan sen makroon.

  1. Nauhoitus päälle: Näytä, Makrot, Tallenna makro (View, Macros, Record Macro).
  2. Annetaan makrolle kuvaava nimi, esim. OtsikkoMuotoilu (nimessä ei saa olla välilyöntejä).
    1. Määrittele mahdollinen pikanäppäin (makron voi myös käynnistää ilman pikanäppäintä).
    2. Tallennuspaikkana on tällä kertaa ihan hyvä valinta Tämä työkirja (This Workbook).
    3. Anna kuvaus makrolle, esim. “Otsikoiden muotoilu solusta A1 alkaen”.
  3. Paina Ctrl + Home. Komento siirtää osoittimen soluun A1.
  4. Paina Ctrl + Vaihto + Nuoli oikealle. Tämä valitsee otsikkorivin.
  5. Paina Lihavointia.
  6. Paina Ctrl + Nuoli vasemmalle. Se siirtää osoittimen takaisin alueen alkuun.
  7. Lopeta nauhoitus: Näytä, Makrot, Lopeta tallennus (View, Macros, Stop Recording).
  8. Testaa.

Voit suorittaa makron joko painamalla antamaasi pikanäppäinyhdistelmää tai kohdasta: Näytä, Makrot, Näytä makrot (View, Macros, View Macros). Valitse haluamasi makro ja napsauta Suorita (Run).

Työkirjan, jossa makro sijaitsee, on oltava avoinna kun makroa suoritetaan.

Voit suorittaa tämän makron myös siten, että avaat toisen työkirjan, jossa haluat muotoilla otsikkorivin. Toiminto kohdistuu tässä tapauksessa aktiiviseen työkirjaan.

Voit tarkastella koodiasi VBA:ssa esim. seuraavasti: Näytä, Makrot, Näytä makrot (View, Macros, View Macros) ja valitse haluamasi makro ja napsauta Muokkaa (Edit).

Makrokoodin tulisi näyttää tällaiselta:

Sub OtsikkoMuotoilu()
' OtsikkoMuotoilu Makro
'
'
   Range("A1").Select
   Range(Selection, Selection.End(xlToRight)).Select
   Selection.Font.Bold = True
   Selection.End(xlToLeft).Select
End Sub

Makro alkaa komennolla Sub ja loppuu komentoon End Sub. Näiden välissä on varsinainen koodi.

Huomaa kohta Range(Selection, Selection.End(xlToRight)).Select.
Jos olisit valinnut alueen käyttämättä pikanäppäintä, olisi tässä nyt alueen valinta, esim. Range(“A1:D1”).Select. Tämä valitsisi aina alueen A1:D1 kun taas pikanäppäimillä tehty valitsisi aina otsikkorivin loppuun tai niin pitkälle kunnes tulee tyhjä solu vastaan.

Heittomerkillä alkavat rivit ovat kommentteja ja oletusasetuksessa vihreinä. Voit tarvittaessa kirjoittaa lisää kommentteja aloittamalla ne aina heittomerkillä.

Takaisin Exceliin pääset esim. File, Close and Return to Microsoft Excel.
Työkirja tulee tallentaa muodossa Excel-työkirja (makrot käytössä), (Excel Macro-Enabled Workbook (.xlsm)).
(Tiedosto Tallenna nimellä ja tallennusmuoto (File, Save as, Save as Type).)

Etunollien lisääminen makrojen avulla

Hävinneet etunollat voidaan lisätä jälkikäteen helposti myös makroja käyttäen.

Ohessa esimerkki postinumeroista.
Olen jakanut toiminnon kahtia:
1. SUB-toimintosarja:
KorjaaPnro käy läpi valitun alueen FOR EACH … NEXT silmukassa ja kutsuu
2. Function-toimintosarjaa:
LisääEtuNollat, joka taas lisää tarvittavat etunollat sille annettuun merkkijonoon ja palauttaa korjatun postinumeron sitä kutsuvalle SUB-toimintosarjalle.

Sub KorjaaPnro()
 'valitaan ensin alue ja käynnistetään sen jälkeen makro
    Dim rngS As Range
    For Each rngS In Selection         'muotoillaan solu tekstiksi
       rngS.NumberFormat = "@"         'kuts.funkt.joka lisää tarvittavat
                                       'etunollat
       rngS = LisääEtuNollat(rngS.Value)
    Next
 End Sub
Function LisääEtuNollat(PNro As String) As String
 'funktion tarkistaa sille annetun merkkijonon pituuden Len -funktiolla
 'tämän jälkeen piituudesta riippuen lisätään etunollat
 'nollien lisäämisessä voidaan myös käyttää muotoa "'0000", eli heitto merkki 'ensimmäiseksi
      Select Case (Len(PNro))
        Case 1
          LisääEtuNollat = "0000" & PNro
        Case 2
          LisääEtuNollat = "000" & PNro
        Case 3
          LisääEtuNollat = "00" & PNro
        Case 4
          LisääEtuNollat = "0" & PNro
        Case Else
          LisääEtuNollat = PNro
        End Select
 End Function

Windowsin rekisterin hyödyntäminen

Silloin tällöin tulee tilanne, että luodessamme uutta asiakirjaa tarvittaisiin edellisestä asiakirjasta viimeiseksi käytettyä tietoa, esimerkiksi juokseva numero Excelissä tai asiakirjan juokseva numero Wordissa.

Tapoja on useampia. Eräs on Windowsin rekisterin hyödyntäminen, jos työ suoritetaan aina samalla koneella.

Jos sitä vastoin tarvitaan enemmän joustavuutta, voitaisiin arvo tallentaa esimerkiksi tekstitiedostona johonkin sitä varten luotuun kansioon.

Windowsin rekisterin hyödyntäminen

Excel-esimerkki:
GetValue hakee arvon rekisteristä ja SaveValue tallentaa.

Sub SaveValue()
    Dim lngArvo As Long
    On Error GoTo ErrH:
    lngArvo = Range("A1")
    SaveSetting appname:="Minun_sovellus", section:="Alustus", Key:="ViimNro", setting:=lngArvo
    Exit Sub
ErrH:
    MsgBox "Solussa A1 on oltava numeerinen arvo", vbExclamation + vbOKOnly, "Virheellinen arvo"
End Sub

Sub GetValue()
    Range("A1") = GetSetting(appname:="Minun_sovellus", section:="Alustus", Key:="ViimNro") + 1
End Sub

Word esimerkki:

Word-asiakirjassa käytetään kirjanmerkkiä AsNro, joka on valmiina asiakirjassa. Kirjoitetaan siihen arvo, joka poimitaan rekisteristä. Lisäyksen jälkeen arvo tallennetaan rekisteriin uudestaan.

Sub AsetaNro()
    Dim lngArvo As Long
    On Error GoTo ErrH
    Selection.GoTo What:=wdGoToBookmark, Name:="AsNro"

    lngArvo = GetSetting(appname:="Minun_sovellus", Section:="Alustus", Key:="ViimNro") + 1
    Selection.TypeText Text:=lngArvo
    SaveSetting appname:="Minun_sovellus", Section:="Alustus", Key:="ViimNro", setting:=lngArvo
    Exit Sub
ErrH:
    MsgBox "Kirjanmerkkiä AsNro ei löytynyt.", vbExclamation + vbOKOnly, "Asiakirjavirhe"
End Sub

Suomenkieliset kuukaudet englanniksi

Itselleni tulee aika usein esiin tilanteita, että jo tehdystä taulusta tulisi muuttaa kuukauden nimet suomesta englanniksi, esimerkiksi kun olen ryhmitellyt Pivot-taulukossa päivämäärät kuukausiksi.

Tein makron, jonka suoritan aina tarvittaessa.
Tallensin makron omaan apuohjelma-makrotyökirjaan, jonka avaan aina tarvittaessa.

Alla kaksi esimerkkiä makrosta.
Ensimmäinen on (Sub Replace_Fin_Months_With_Eng), jossa valitsen ensin alueen ja sitten suoritan makron. Toinen on (Sub Replace_Fin_Months_With_Eng_v2), jossa makro kysyy muunnettavaa aluetta.
Molemmissa makroissa käytän FOR EACH NEXT silmukkaa, jolloin vältyn hitaasta SELECT-käskystä.

Sub Replace_Fin_Months_With_Eng()
'2013 / BI
'Replace finnish month namnes with english
'Select first cells and then run makro
    Dim c As Range
    For Each c In Selection
        Select Case c.Value
            Case "tammi"
                c.Value = "Jan"
            Case "helmi"
                c.Value = "Feb"
            Case "maalis"
                c.Value = "Mar"
            Case "huhti"
                c.Value = "Apr"
            Case "touko"
                c.Value = "May"
            Case "kesä"
                c.Value = "Jun"
            Case "heinä"
                c.Value = "Jul"
            Case "elo"
                c.Value = "Aug"
            Case "syys"
                c.Value = "Sep"
            Case "loka"
                c.Value = "Oct"
            Case "marras"
                c.Value = "Nov"
            Case "joulu"
                c.Value = "Dec"
        End Select
    Next
End Sub

Sub Replace_Fin_Months_With_Eng_v2()
'2013 / BI
'Replace finnish month namnes with english
'Makro that asks what range should be converted

    Dim c As Range
    On Error Resume Next
    Set c = Application.InputBox("Valitse alue joka muunnetaan", _
        "Kuukausien vaihto", , , , , , 8)
    On Error GoTo 0
    If Not c Is Nothing Then
        c.Select
        For Each c In Selection
            Select Case LCase(c.Value)
                Case "tammi"
                    c.Value = "Jan"
                Case "helmi"
                    c.Value = "Feb"
                Case "maalis"
                    c.Value = "Mar"
                Case "huhti"
                    c.Value = "Apr"
                Case "touko"
                    c.Value = "May"
                Case "kesä"
                    c.Value = "Jun"
                Case "heinä"
                    c.Value = "Jul"
                Case "elo"
                    c.Value = "Aug"
                Case "syys"
                    c.Value = "Sep"
                Case "loka"
                    c.Value = "Oct"
                Case "marras"
                    c.Value = "Nov"
                Case "joulu"
                    c.Value = "Dec"
            End Select
        Next
    End If
End Sub

PowerPointin kuvien kielen vaihtaminen

Kuinka moni on tuskaillut kuvien eri tekstiosien kieliasetuksilla?

Itse olen monesti, mutta nyt sain ainakin omissa kuvissani kieliasetukset toimimaan seuraavalla pienellä makrolla. Makro käy läpi kaikki aktiivisen esityksen kuvat ja niiden tekstiruudut (shapes) ja muuttaa kieleksi us english.

Jos kieli halutaan uk englanniksi tai suomeksi, kommentoidaan us englanti -rivi ja poistetaan kommenttimerkki (‘) sen rivin kohdalta, mihin kieleen halutaan vaihtaa.

Esim. halutaan vaihtaa kieli suomeksi: poista kommenttimerkki tältä riviltä koodissa
‘sh.TextFrame.TextRange.LanguageID = msoLanguageIDFinnish

Sub ChgLng() 
'change language to us/uk- english/finnish
    Dim sld As Slide
    Dim sh As Shape
        On Error Resume Next
        For Each sld In ActivePresentation.Slides
            For Each sh In sld.Shapes
                'us englanti
                sh.TextFrame.TextRange.LanguageID = msoLanguageIDEnglishUS
                'uk englanti
                'sh.TextFrame.TextRange.LanguageID = msoLanguageIDEnglishUK
                'suomi
                'sh.TextFrame.TextRange.LanguageID = msoLanguageIDFinnish
            Next
        Next
End Sub

Makron kopioit PowerPoint moduuliin seuraavasti:

Valitse koodi.
Paina Ctrl + c (kopioi).
Paina Alt + F11.
Valitse Insert – Module.
Paina Ctrl + v (liitä).

Suorita koodi esimerkiksi seuraavasti: laita osoitin koodin ja paina F5.

Suorita koodi toisessa esityksessä:

Pidä avoinna esitys, johon koodin kopioit, ja avaa esitys, jota haluat muuttaa.
Valitse Näytä – Makrot, Makrot (View – Macros, Macros).
Avautuvasta valintaikkunasta valitse makrojen lähteeksi Kaikki avoimet esitykset ja tämä kyseinen makro ChgLng.

Virheiden hallinta

ON ERROR

Virhehallinta otetaan käyttöön ON ERROR GOTO xxx -komennolla.

xxx on nimi, johon siirrytään virheen tapahtuessa.

Esim.:

ON ERROR GOTO VirheHallinta

Virheenhallintarutiini on usein proseduurin lopussa ja kirjoitetaan muodossa:

VirheHallinta:

Huomaa kaksoispiste.

Virhehallinnasta palataan takaisin ohjelmaan komennolla: ON ERROR RESUME tai ON ERROR RESUME NEXT.

ON ERROR RESUME palauttaa ohjelman sille riville joka aiheutti virheen kun taas ON ERROR RESUME NEXT palauttaa seuraavalle riville siitä rivistä, joka aiheutti virheen.

Virhehallinta palautetaan Excelille komennolla ON ERROR GOTO 0 minkä jälkeen Excelin normaali virhehallinta on taas käytössä.

Voit poistaa ja ottaa käyttöön myös sisäiset virheilmoitukset komennolla:

APPLICATION.DISPLAYALERTS = FALSE ja APPLICATION.DISPLAYALERTS = TRUE

Käytä tätä harkitusti ja jos käytät, tarkista että virhehallintasi todella toimii!

Muista laittaa DISPLAY ALERTS TRUE kun et sitä enää tarvitse.

Ennen virhehallintariviä kirjoita EXIT SUB jos kyseessä SUB-proseduuri tai EXIT FUNCTION jos kyseessä FUNCTION-proseduuri. Näin vältytään päätymästä virhehallintaan jos ohjelma suoritetaan loppuun virheittä.

Esimerkki:

Virheen hallinta

Virheen hallinta

 

Infoa käyttäjää ohjelman edistymisestä

Kolme esimerkkiä informoida käyttäjää miten ohjelma edistyy.
Kahdessa ensimmäisessä käytän tilariviä (StatusBar) ja kolmannessa käytän valintaikkunaa.

Koodi lukee soluja ja kertoo kuinka ohjelma edistyy.
Tilarivillä voit esittää esim. laskurilla tai tekstillä missä mennään.

Application.StausBar = ”Teksti tai luku jota näytetään”

Tilarivin tyhjennät seuraavalla tavalla:

Application.StausBar = ””

Mikäli et tyhjennä tilariviä jää merkintä siihen kunnes tilariviä päivitetään uudelleen tai kun Excel käynnistetään uudestaan.

 Esimerkki 1

Tilarivillä kerrotaan laskurilla i, monesko solu menossa.

Sub NaytaEdistyminen()
    Dim i As Long                  'laskuri
    Dim s As Range                 'solu jota käsitellään
    Range(Selection, Selection.End(xlDown)).Select
    i = 1
    For Each s In Selection
        Application.StatusBar = i  'tilarivi kertoo laskurin avulla monennetta solua luetaan
       i = i + 1
        'Laita oma koodisi tähän
    Next
    Application.StatusBar = ""      'tilarivi tyhjennetään
End Sub

Esimerkki 2

Tilarivillä kerrotaan kuinka monta prosenttia on käsitelty.
Muuttuja i kertoo mitä rivi käsitellään ja muuttuja j kuinka monta riviä on alueessa. Kuinka monta prosenttia on luettu saadaan kaavalla i/j muotoiltuna prosentiksi.

Sub NaytaEdistyminen2()
    Dim i As Long        'laskuri
    Dim j As Long        'muuttuja joka sisältää alueen kokonaisrivimäärän
    Dim s As Range
    Range(Selection, Selection.End(xlDown)).Select
    j = Selection.Rows.Count       'lasketaan alueen rivit
    i = 1
    For Each s In Selection
        'lasketaan prosenteissa kuinka paljon tehty
        Application.StatusBar = Format(i / j, "0.00%") 
        i = i + 1
        'Laita oma koodisi tähän
    Next
    Application.StatusBar = ""      'tilarivi tyhjennetään
End Sub

Esimerkki 3

Käytetään lomaketta jossa kerrotaan missä mennään. Se voidaan asettaa keskelle näyttöä jolloin se varmasti huomataan.
Koodi on kuten esimerkissä kaksi paisti että edistymisen näyttämiseksi käytetään lomaketta.
Lokmake on Form joka on määritelty ei modaaliseksi (ShowModal = False). Lomakkeen nimeksi on annettu FrmEdistyminen.
Lisäksi lomakkeelle on määritelty kaksi Label –objeltia, yksi johon laitettu teksti ”Luetteu” ja toinen joka on nimetty lblNayta ja jota ohjelma päivittää.

Objektien fonttikokoa on myös laitettu isommaksi.

Sub NaytaEdistyminen3()
    Dim i As Long
    Dim j As Long
    Dim s As Range
    Range(Selection, Selection.End(xlDown)).Select
    j = Selection.Rows.Count
    i = 1
    FrmEdistyminen.Show      'tuodaan lomake näyttöön
    For Each s In Selection
                  'lomakkeen objektia (lblNayta) päivitetään
        FrmEdistyminen.lblNayta.Caption = Format(i / j, "0.00%") 
        i = i + 1
    Next
    Unload FrmEdistyminen    'suljetaan lomake ja poistetaan muistista
End Sub

Lomakkeen asetukset kuvana

Lomakkeen asetukset

Lomakkeen asetukset

 

PowerPivot päivitys

Automaattinen Pivot ja PowerPivot päivitys toimii Excel versiossa 2013.

Excel versioon 2013 on lisätty ominaisuus jolla päivitys voidaan hoitaa automaattisesti.

Jos se halutaan tehdä normaalissa moduulissa, lisätään seuraava koodirivi makroon:

ActiveWorkbook.Model.Refresh

Jos päivitys halutaan taas tehdä kun työkirja avataan se lisätään ThisWorkbook kohtaan Sub_ Workbook_Open:

Private Sub Workbook_Open()
     Me.Model.Refresh
End Sub

Kuukauden lisäys ja solujen tyhjennys

Kuukauden lisäys

Taas kerran tarvitsin toiminnon jolla lisätään yksi kuukausi annettuun päivämäärään.
Ratkaisin sen omalla funktiolla “LisaaKuukausi”
VBA:ssa voit käyttää DateAdd komentoa päivämäärien laskentaan.

Oheisessa funktiossa syötän funktiolle päivämäärä johon lisätään kuukausi.
Funktiossa muotoillaan palautettava päivämäärä ja jotta se palautuisi muunlaisena kun päivän sarananumerona olen vielä määritellyt funktion palautustyypiksi variantin.
Kuukausi lisätään komennolla DateAdd(“m”, 1, pvm) jossa
m – kertoo että lisätään kuukausi
1 – kuinka monta kuukautta lisätään
pvm – funktiolle annettu argumentti

Tämä kaikki muotoillaan Format komennolla muotoon dd.mm.yyyy joka on sama kuin pp.kk.vvvv.

Function LisaaKuukausi(pvm As Date) As Variant

     LisaaKuukausi =  Format(DateAdd("m", 1, pvm), "dd.mm.yyyy")

End Function

Solujen tyhjennys

Tarvitsin myös toiminnon joka poistaa soluista kaiken muun paisti kaavat.
Ohessa proseduuri jota käytin.
Se ei ole täydellinen mutta toimi juuri siinä kun sitä tarvitsin.
Valitaan alue ja suoritetaan ohjelma.
Ohjelma tarkistaa jos solussa on kaava (HasFormula) ja jos ei ole niin solu tyhjennetään.

Sub PoistaSisalto()

Dim s As Range
For Each s In Selection
    If Not s.HasFormula Then
       s.ClearContents
    End If
Next
End Sub


Lisää esimerkit koodi-ikkunaan

Yllä olevat proseduurit voit lisätä työkirjan makroiksi esim. seuraavalla tavalla:
Kopioi esimerkin koodi

Valitse koodi
Paina Ctrl + c (kopioi)
Paina Alt+F11
Valitse Insert – Module
Paina Ctrl + v (liitä)

Tämän jälkeen löydät funktion työkirjassa kohdasta lisää funktio, luokka käyttäjän määrittämä (User defined)

SUB –proceduurin voit suorittaa esim. kohdasta Näytä (valintanauha), Makrot (ryhmä), Makrot, Näytä makrot. (View, Macros, Macros, Show Macros)

 

Sähköpostiosoitteen poiminta hyperlinkkisolusta

Viikko takana ja mm tämä asia viikolla esiin.

Osoitelista Excelissä jossa on hyperlinkit sähköpostiositteissa.
Eli kun osoitat solua Excel näyttää sinulle “mailto:nimi@osoite.com”
Jos haluat vaikka kopioida kaikki sähköpostiositteet erikseen liittääksesi ne johonkin niin se on mahdotonta.

Otetaan VBA käyttöön ja homma hoituu.

Luodaan funktio VBA:han joka poistaa mailto: -osan ja kirjoittaa soluun pelkän sähköpostiosoitteen.

Paina Alt+F11 ja VBA avautuu
Valitse VBA –editorissa Insert, Module
Kopioi alla oleva koodi moduuliin

Function SahkopostiOsoite(HyperlinkkiSolu As Range)
       SahkopostiOsoite = Replace(HyperlinkkiSolu.Hyperlinks(1).Address, “mailto:”, “”)
End Function

Siirry taulukkoosi ja valitse Kaavat/Lisää funktio, valitse luokka Käyttäjän määrittämät (Formulas/Insert Function, User defined)
Valitse luomasi funktio ja anna sille argumentiksi solu joka sisältää hyperlinkin.
Esim:
=SahkopostiOsoite(B2)

Se on siinä!