Keskustelu: Ohjelmointikysymykset: VBA: Excel solujen lukitseminen VBA

Terve,

olisi seuraavanlainen ongelma.

Haluaisin VBA:n avulla tehdä tietyille soluille (esim.A1-A21) suojauksen, jolloin niitä ei enää voitaisi muokata millään tavalla.

Olen aika kokematon ohjelmoinnin ja etenkin Vb:n kanssa, joten apua tarvittaisiin. Kiitoksia avusta jo etukäteen!

Jotain tällaista olen yrittänyt tässä räpeltää, mutta ei oikein toimi.

Sub SolutLukkoon()

Range("A2").Select

Selection.Locked = True

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Oletuksena kaikki solut on lukittu, mutta lukitus astuu voimaan vasta, kun sivu suojataan tuolla käyttämälläsi Protect-komennolla. Helpompi on määrittää mitä soluja ei lukita ennen suojauksen kytkemistä, kuin lukita vain tietyt solut. Seuraavassa leikitään lukituksella suojatulla sivulla.

Sub Lukitse()

On Error GoTo ErrorTerror

    Application.ScreenUpdating = False 'estetään näytön vilkkuminen
    With ActiveSheet.Range("B2") 'kaikki seuraavat rivit, jotka alkavat pisteellä, jatkuvat tästä
        .Value = "" 'tyhjätään solu
        .Locked = False 'poistetaan lukitus
        ActiveSheet.Protect "Testing", DrawingObjects:=True, Contents:=True, Scenarios:=True
        MsgBox "Seuraavaksi yritetään koemielessä muuttaa solun " _
          & Replace(.Address, "$", "") & " lukitusta suojatulta sivulta."
        .Locked = True 'yritetään palauttaa lukitus
        MsgBox Replace(.Address, "$", "") & " on lukittu: " & .Locked 'ilmoitetaan lukituksen tila
        If Not .Locked Then .Value = "foo" 'syötetään suojatulle sivulle arvo
        MsgBox .Value
        ActiveSheet.Protect "Testing", DrawingObjects:=False, Contents:=False, Scenarios:=False
        .Locked = True 'palautetaan lukitus, vaikkei sillä ole merkitystä suojaamattomalla sivulla
        MsgBox Replace(.Address, "$", "") & " on lukittu: " & .Locked
    End With
    Application.ScreenUpdating = True
    Exit Sub

ErrorTerror:
    MsgBox "Solu on suojattu.", vbCritical, "Virhe"
    Err.Clear
    Resume Next 'palataan riville, joka seuraa virheen aiheuttanutta
End Sub

Tjoo-o, kiitoksia neuvosta... Onko tuohon Exceliin mahdollista tehdä tuolla VBA:lla ihan vaan joku Read-Only homma, ilman tuota protectin kanssa leikkimistä? Ettei tule sitä ilmoitusta että protect on päällä joka kerta kun klikkaa lukittua solua?

Jos haluat pelkästään estää muutosten tallentamisen, niin VB Editorin ThisWorkbook-modulista löytyy Workbookin alta tapahtuma BeforeSave, jossa määritellään mitä tehdään ennen kuin työkirja tallennetaan. Jos siellä kytketään Cancel päälle, niin tallennus estyy, eli...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True 'työkirjan tallennus on estetty
End Sub

Edit: koodin siistimistä

hmm en aivan tätäkään hakenut, mutta mielenkiintoinen koodinpätkä tuokin. :) Olen nyt tässä yrittänyt saada sellaisen jutun tehtyä, että tuo koodi katsoisi solun värin perusteella että mistä soluista pitää ottaa tuo lukitus pois. Tälläisen löysin tuolta netistä, mutta en saa sitä toimimaan ja kuinka saisin tuon funktion tallentamaan tiedon johonkin muuttujaan että saisin käytettyä sitä edellä mainitussa koodissa?

Function CellColorIndex(InRange As Range, Optional _
    OfText As Boolean = False) As Integer
'
' This function returns the ColorIndex value of a the Interior
' (background) of a cell, or, if OfText is true, of the Font in the cell.
'
Application.Volatile True
If OfText = True Then
    CellColorIndex = InRange(1,1).Font.ColorIndex
Else
    CellColorIndex = InRange(1,1).Interior.ColorIndex
End If

End Function

'You can call this function from a worksheet cell with a formula like
'=CELLCOLORINDEX(A1,FALSE)

Edit. Taisin saada homman toimimaan, ajattelin liian vaikeasti. Kiitos avusta ja etenkin tuosta ensimmäisestä koodin pätkästä! Kyselen lisää taas jos (ja kun) tulee taas ongelmia!

Kuinka saan For-silmukan käymään läpi esim. solut A1:A10?

For Each -rakenteella...=)

Dim Solu As Range

For Each Solu In Range("A1:A10")
    Solu.Value = "Solu " & Solu.Row
Next Solu

No niin, vielä olen pulassa. En käsitä miten minä en saa tehtyä semmoista pätkää mikä vaan kävisi yksinkertaisesti läpi solut A1:J190, ja asettaisi lukituksen niihin joiden väri on 15. Muuten homma toimii mutta en vaan saa nyt enää millään tuota lukitsemis hommaa toimimaan! Kiitos taas avusta etukäteen!

Eipä tuon pitäisi kovin vaikeaa olla...

Sub EmergencyLockdown()
    Dim solu As Range

    Application.ScreenUpdating = False 'ei näytetä käyttäjälle, jos käsitellään soluja tms.
    For Each solu In Range("A1:J190")
        solu.Locked = (solu.Interior.ColorIndex = 15) 'sulkujen sisältä palautuu joko True tai False
    Next solu
    ActiveSheet.Protect Password:="Testing", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True 'pakollinen palautus
End Sub

Joo, nyt toimii. Kiitos erittäin paljon!

Vielä olisi kysymys, eli kuinka saisin tuon koodin käynnistymään automaattisesti kun työkirjaan on lisätty tietoa Data-->Import external data-menetelmällä?

Joo eli laitan nyt koko tämän koodin vielä tähän. Homma pitäisi saada toimimaan niin, että tuo koodi suoritettaisiin, kun käyttäjä on Importannut erään Xml-tiedoston Exceliin (AfterImportXml-event ei käy). Onko vielä jotain keinoja, olen kokeillut WorkSheet_Change eventtiä eikä toiminut. Koodi on tällä hetkellä napin takana.

Private Sub CommandButton1_Click()

Dim Solu As Range

ActiveSheet.Protect Password:="jee", DrawingObjects:=False, Contents:=False, Scenarios:=False

Application.ScreenUpdating = False

For Each Solu In ActiveSheet.UsedRange

    Solu.Locked = (Solu.Interior.ColorIndex = 15)

Next Solu

    ActiveSheet.Protect Password:="jee", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True

    MsgBox "Lukittu!"

End Sub

mites jos ajatellaan toista tilannetta. Taulukon monessa solussa on jokin laskutoimitus tyyliin '=a2+b3' jolloinhän solun arvoksi tulee an ja bn summa.

Miten tuon saisi suojattua niin, että käyttäjä näkisi ainoastaan solun lasketun arvon, mutta ei pääsisi muuttamaan/katsomaan mista se arvo on laskettu?

ja kaiken päälle pitäisi saada toimimaan vain erikseen määritellyillä soluilla.

vba on kätevä jos sitä vain osaa käyttää..

Minä kirjoitti:

Taulukon monessa solussa on jokin laskutoimitus tyyliin '=a2+b3' jolloinhän solun arvoksi tulee an ja bn summa.

Miten tuon saisi suojattua niin, että käyttäjä näkisi ainoastaan solun lasketun arvon, mutta ei pääsisi muuttamaan/katsomaan mista se arvo on laskettu?

ja kaiken päälle pitäisi saada toimimaan vain erikseen määritellyillä soluilla.

Formula ja FormulaHidden parilla tuo onnistuu. Worksheet pitää olla suojattu. Workbookin suojaus, jos Worksheet on kuitenkin suojaamatta, ei vaikuta FormulaHiddeniin.

'Esimerkki laskee O-sarakkeesta lähtien soluun sarakkeiden C ja K erotuksen solua tuplaklikkaamalla.
'Kaava on piilotettu, mutta tulos näkyy solussa.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column > 14 Then
        ActiveSheet.Protect Password:="jee", DrawingObjects:=False, Contents:=False, Scenarios:=False
        Target.Formula = "=$K$" & Target.Row & "-$C$" & Target.Row
        Target.FormulaHidden = True
        ActiveSheet.Protect Password:="jee", DrawingObjects:=True, Contents:=True, Scenarios:=True
        Cancel = True
    End If
End Sub

Minä: Hienosti kaapattu toisen viestiketju. Normaalisti kannattaa aloittaa uusi, niin joku sen ehkä huomaakin...=)

AleksiR: Jossain olen nähnyt jonkin vastaavan tilanteen/ratkaisun tuohon ongelmaasi, mutta en nyt muista missä ja milloin, eikä nopea googlaus tuonut asiaan ratkaisua... Pitää vielä katsella.

Joo kiitos BadSource, olen yrittänyt itse tässä päivän mittaan googlailla mutta ei ole osunut ratkaisua silmään. Olisin erittäin kiitollinen jos satut ratkaisun löytämään. :)

Ja niin, siis tuo Change-event toimii periaatteessa, mutta se alkaa suorittaa heti tuota koodia ja lukitsee sheetin ennenkuin tiedosto on saatu exportattua. Tuo koodi pitäisi saada käyntiin kun exporttaus on valmis, tuollaisenaan tuolla Change-eventilla ei saa exportattua kuin ensimmäisen rivin.

Olen alkanut tulla siihen tulokseen että VBA:lla tuo koodin käynnistäminen halutulla tavalla taitaa olla mahdotonta. Mitenkähän tuon Import External File-dialogin saisi avattua vaikka aina tuon workbookin käynnistyessä? Siihen sitten sotkisi tuon koodin mukaan jotenkin.

ThisWorkbook:n alta löytyy WorkBook_Open(), joka ajetaan, kun työkirja avataan. Dialogin avaaminen saattaa olla hankalampaa...

BadSource kirjoitti:

ThisWorkbook:n alta löytyy WorkBook_Open(), joka ajetaan, kun työkirja avataan. Dialogin avaaminen saattaa olla hankalampaa...

Onko mitään ideoita, jos se nyt on edes mahdollista?

Vaihteleeko tuo haettevan datan lähde, vai onko se koko ajan sama? Dialogia en saanut avautumaan, eikä siitä löytynyt Googlellakaan mainintaa. Makron nauhoittaminenkin vain tallentaa datan hakemisen ja liittämisen sivulle, ilman dialogilla pysähtymistä. Seuraava siis hakee tietystä access-kannasta tietyn taulun sisällön.

Sub Macro2()
'
' Macro2 Macro
' Macro recorded 4.9.2006 by bad
'

'
    With ActiveSheet.QueryTables.Add(Connection:=Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;", _
        "User ID=Admin;", _
        "Data Source=C:\Documents and Settings\bad\My Documents\Konekanta.mdb;", _
        "Mode=Share Deny None;Extended Properties="""";", _
        "Jet OLEDB:System database="""";", _
        "Jet OLEDB:Registry Path="""";", _
        "Jet OLEDB:Engine Type=4;", _
        "Jet OLEDB:Database Locking Mode=0;", _
        "Jet OLEDB:Global Partial Bulk Ops=2;", _
        "Jet OLEDB:Global Bulk Transactions=1;", _
        "Jet OLEDB:New Database Password="""";", _
        "Jet OLEDB:Create System Database=False;", _
        "Jet OLEDB:Encrypt Database=False;", _
        "Jet OLEDB:Don't Copy Locale on Compact=False;", _
        "Jet OLEDB:Compact Without Replica Repair=False;", _
        "Jet OLEDB:SFP=False"), Destination:=Range("A1"))
        .CommandType = xlCmdTable
        .CommandText = Array("Kayttajat")
        .Name = "+Connect to New Data Source"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceConnectionFile = _
        "C:\Documents and Settings\bad\My Documents\My Data Sources\(Default) Kayttajat.odc"
        .Refresh BackgroundQuery:=False
    End With
End Sub

ps. Vaihtamalla .CommandText-kohtaan esimerkiksi SQL-haun, niin saa hieman spesifisempää dataa.

Ai niin enhän minä sitä tietysti muistanut mainita että siksi se dialogi on tarpeellinen, koska avattava tiedosto vaihtelee.. Alkaa mennä jo melko vaikeaksi. :D

Edit. Homma toimii! Tässä nyt vielä ratkaisu, en älynnyt että homma näköjään ratkeaa ihan yksinkertaisesti AfterXmlImport eventillä.

Private Sub Workbook_AfterXmlImport(ByVal Map As XmlMap, ByVal IsRefresh As Boolean, ByVal Result As XlXmlImportResult)
       Dim Cell As Range

       ActiveSheet.Protect Password:="123", DrawingObjects:=False, Contents:=False, Scenarios:=False
       Application.ScreenUpdating = False
       For Each Cell In ActiveSheet.UsedRange
           Cell.Locked = (Cell.Interior.ColorIndex = 15)
       Next Cell

       ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
       Application.ScreenUpdating = True
       MsgBox "Locked!"
  End Sub