kunde

Vapaa kuvaus

Isaan Rules WFF CCC If you walked away smiling-then for you the price was right Keep Exceling Suosikkibändit/artistit: Queen, Rammstein, genesis, Bruce Bringsteen, Kino, Mandref Mann Earth band Who Lempikirjat: ohjelmointi... Suosikkipalstat Suomi24 Keskusteluissa: EXCEL, Kivitalot, EPS En pidä: pakkanen ja loskakelit Ruoka & juoma: loimulohi ja valkkari Linkit: http://www.kundepuu.com, Khorat Koulutus: --- Ammatti: Tiede/teknologia Työskentelen: freelancer Ase tai siviilipalvelus: yliluutnantti Siviilisääty: Varattu Lapset: --- Hakusanat: Thaimaa, korat, Excel, VBA, ACAD, CNC, Polyurea, EPS, MgO elementti

Aloituksia

7

Kommenttia

1374

  • Uusimmat aloitukset
  • Suosituimmat aloitukset
  • Uusimmat kommentit
  1. excel käyttää IEEE (Institute of Electrical and Electronic Engineers)standardia numeroiden varastoimiseen ja sen tarkkuus on 15 numeroa ja sen jälkeiset luvut pyöristetään. Ainoastaan tekstinä voit näyttää isompia lukuja.
  2. kopioi toisen taulukon tiedot toiseen taulukkoon ja suodata uniikit...
  3. en ole tarkistanut originaalikoodin toimivuutta...

    Private Const dsWarningSheet As String = "sheet6" 'Enter name of the Entry/Warning Page

       Private Sub Workbook_Beforesave(ByVal SaveAsUI As Boolean,
    Cancel as Boolean)
    For Each ds In ActiveWorkbook.Sheets
    If LCase(dsWarningSheet) = LCase(ds.Name) Then
    ds.Visible = True
    Else
    ds.Visible = xlVeryHidden
    End If
    Next

    If SaveAsUI = True Then Cancel = True

    End Sub

       Private Sub Workbook_SheetSelectionChange(ByVal ds As Object, ByVal Target As Excel.Range)
    If LCase(ds.Name) = LCase(dsWarningSheet) Then
    For Each ds In ActiveWorkbook.Sheets
    ds.Visible = True
    Next
    ActiveSheet.Visible = xlVeryHidden
    End If
    End Sub

       Private Sub workbook_open()
    Sheets(dsWarningSheet).Select
    For Each ds In ActiveWorkbook.Sheets
    ds.Visible = True
    Next
    ActiveSheet.Visible = xlVeryHidden
    End Sub
  4. oli koneella probleemia ja ei pystynyt lähettämään viestiä ja edellinen onkin jo kertonut samat jutut sillä aikaa...
  5. Ainahan käyttäjä voi ajaa toiselta työkirjalta makron ja tehdä mitä vaan sun työkirjallesi jos ohjelmointitaitoa riittää...
    No asiaan.
    Makrojen suojaustasoa voit muuttaa alhaiseksi,jolloin makrojen hyväksyntää ei kysellä tai sitten teet makron, joka tekee seuraavaa
    1. Suljettaessa tai tallennettaessa piilotetaan kaikki taulukot paitsi yksi ns. pääsivu. Tälle sivulle infoa, jolla kerrot, että käyttäjän on otettava makrot käyttöön käynnistämällä työkirja uudelleen.
    2. Jos käyttäjä ei hyväksy makroja avataan excel ja vain pääsivu näkyy...
    3.Jos hyväksyy makrot niin toimii normaalisti. Käytä Excelin xlVeryHidden ominaisuutta piilottaessasi taulukot, jolloin niitä ei saa näkyviin menun kautta
    Keep Exceling :-)
  6. ei kovin vaikeaa...
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
    'vasemmalle
    ActiveSheet.PageSetup.LeftFooter = Range("A3")
    'keskelle
    'ActiveSheet.PageSetup.CenterFooter = Range("A3")
    'oikealle
    'ActiveSheet.PageSetup.RightFooter = Range("A3")
    End Sub
  7. Nyt funktio on VOLATILE funktio, joka päivittyy aina kun taulukossa tehdään uudelleenlaskenta. Kokeile vaikka seuraavasti.
    esim.
    soluun A1 =NYT()ja siihen oma solumuotoilu t:mm:ss ja sitten painelet funktionäppäintä F9
    Muuttuiko aika?

    Keep Excelling :-)
  8. ThisWorkBook moduuliin...

    muuta koodissa solun osoite

    Makro päivittää päiväyksen juuri ennen tulostusta
    Toinen keino on painaa F9 näppäintä juuri ennen tulostusta, jolloin excel tekee uudelleen laskennan kaavoille ja VOLATILE funktioille( Nyt()on tähän ryhmään kuuluva funktio)

    Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Range("A1") = Now()
    End Sub
  9. vai ei excel osaa laskea yli 24 meneviä tunteja. taidatkin olla JMS koulutuksen saaneita huippuosaajia...
  10. mutta voihan suodatettavan kentän otsikkorivin vaihtaa helposti...
    alla oleva koodi vaatii jonkun excelin VOLATILE funktion käyttämistä ko taulukossa
    jaa, että mitä ne VOLATILE funktiot on? Jääköön se lukijan selvitettäväksi, mutta lisää taulukkoosi johonkin soluun kaavaksi esim lontoonkielellä =TODAY tai suomiversiossa =TÄMÄ.PÄIVÄ() niin allaoleva koodi toimii...
    eli koodi muuttaa suodatetun kentän taustavärin nyt keltaiseksi, joten sen ainakin huomaa

    taulukon moduuliin...

    Private Sub Worksheet_Calculate()
    Dim SuodatusRivi As Integer
    Dim laskuri As Integer
    Dim Kentat As Integer
    On Error Resume Next
    Application.EnableEvents = False
    SuodatusRivi = Me.AutoFilter.Range.Row
    Kentat = Me.AutoFilter.Filters.Count
    Range(Cells(SuodatusRivi, 1), Cells(SuodatusRivi, Kentat)).Interior.ColorIndex = xlNone
    If ActiveSheet.FilterMode = True Then
    For laskuri = 1 To Kentat
    If ActiveSheet.AutoFilter.Filters.Item(laskuri).On Then
    'nyt keltainen muuta allaolevaa numeroa
    Cells(SuodatusRivi, laskuri).Interior.ColorIndex = 6
    End If
    Next laskuri
    End If
    Application.EnableEvents = True
    On Error GoTo 0
    End Sub
  11. Suomenkielisilla kirjoilla voi pyyhkia per*****. Samat ikivanhat esimerkit ja muutenkin ihan ala-arvoisia. Jos lontoon murre hallussa niin osta kirja.Muutama suositeltava kirja on...
    Lue ulkolaisia foorumeita ja tutki niiden koodeja
    Nauhoita makroja ja opettele "siistimaan" niita
    P.S. pian aukeaa Kunden portaali, jossa sitten ssat asiatietoa ihan suomen kielella ja voit lahetella tiedostoja yms...
    kunhan nyt saisin suomikaannokset valmiiksi foorumille... mutta ei nin hirveesti jaksa taalla Thaimaassa...
  12. Vba:lla piece of cake.

    Mutta neuvotaanpa tällä kertaa ilman sitä.

    1. lisää listaasi otsikkorivit(ellei niitä jo ole) tyyliin etunimi, sukunimi,osoite...
    2. valitse lista ja luo listalle nimet Lisää/Nimi/Luo/luo nimet yläriviltä ja vasemmasta sarakkeesta.
    3. kirjoitat sitten uuteen listaasi kaavat ja kopioit niitä alaspäin
    esim A sarakkeessa nimet, B sarakkeessa osoite

    esim. osoite (B)sarakkeeseen
    =EPÄSUORA(A4) osoite ja kaava hakee listasta Ville Virtasen (solu A4) osoitteen esim Tilatie 1 B 36

    ei kummonen juttu ja helppo muistaa kaavat
  13. moduuliin...
    avatessa lisää lukua

    Sub Auto_Open()
    Range("A1") = Range("A1") + 1
    End Sub

    suljettaessa lisää lukua

    Sub Auto_Close()
    Range("A1") = Range("A1") + 1
    End Sub

    vaihtoehtoisesti ThisWorkbook moduuliin...

    lisää lukua suljettaessa

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Range("A1") = Range("A1") + 1
    End Sub

    lisää lukua tulostettaessa

    Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Range("A1") = Range("A1") + 1
    End Sub

    lisää lukua tallennettaessa

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Range("A1") = Range("A1") + 1
    End Sub

    käytä vaan yhtä noista ja oman makronhan voi aina tehdä...
    vaihtoehtoja riittää

    Sub Joku()
    Range("A1") = Range("A1") + 1
    End Sub

    Keep Excelling ;-)
    @Kunde
  14. liitä makro ohjeiden mukaan ja tallenna työkirja, Makro toimii siinä taulukossa mihin koodin liitit automaattisesti. Eli kun syötät luvun A sarakkeeseen lisää sen vastaavaan B sarakkeen lukuun. Ei toimi muissa sarakkeissza vain ja ainosataan kun A sarakkeen solun arvo muuttuu
  15. Taul1 tai mihinka olemassa olevaan taulukossa haluat koodin toimivan liita se ko taulukon moduuliin Projektin hallinta/Excelin objektit.Taulukon moduulit(niissa on taulukon kuva) on ThisWorkbook(vihrea x valkealla paperilla) moduulin ylapuolella.Ala lisaa uutta moduulia.
    nyt lisaa myos rivin, olikin tullut tuplana toi koodi...

    Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo virhe:
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
    If IsNumeric(Target) Then
    Target.Offset(0, 1) = Target.Offset(0, 1) + Target
    Target.Offset(1, 0).EntireRow.Insert
    Else
    MsgBox "syottamasi arvo ei ollut luku! "
    Target.Select
    GoTo virhe
    End If
    End If
    virhe:
    Application.EnableEvents = True
    End Sub
  16. Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
    If IsNumeric(Target) Then
    Target.Offset(0, 1) = Target.Offset(0, 1) + Target
    Else
    MsgBox "syott?m?si arvo ei ollut luku! "
    Target.Select
    Exit Sub
    End If
    End If
    End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
    If IsNumeric(Target) Then
    Target.Offset(0, 1) = Target.Offset(0, 1) + Target
    Else
    MsgBox "syottamasi arvo ei ollut luku! "
    Target.Select
    Exit Sub
    End If
    End If
    End Sub
  17. 1. tee Visual Basic tyokaluvalikosta combobox taulukkoon haluaamisi kohtaan
    2. laita comboboxin ListFillRange kohtaan lista hyperlinkeista tyyliin A1:A10
    3.liita allaoleva koodi comboboxiin

    Private Sub ComboBox1_Change()
    Range("A1").Offset(ComboBox1.ListIndex, 0).Hyperlinks(1).Follow
    End Sub

    oleuksena nyt, etta hyperlinkit alkaa solusta A1 muuta sita tarvittaessa

    Keep Excelling :-)
  18. taulukon moduuliin...

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("A1")) Is Nothing Then
    If IsNumeric(Target) Then
    Range("B1") = Range("B1") + Range("A1")
    Else
    MsgBox "syottämäsi arvo ei ollut luku! "
    Range("A1").Select
    Exit Sub
    End If
    End If
    End Sub
  19. moduuliin...

    Sub koe()
    Dim Sivunalku As String
    Dim Alue As Range
    Dim i As Integer
    Dim j As Integer
    Dim alkuwb As String
    Dim uusiwb As String
    Dim Sivunvaihto As Integer
    Dim Rivit As Long
    Dim Polku As String
    Dim Sivunkoko As Integer

    On Error GoTo virhe
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    takaisin:
    Sivunkoko = Application.InputBox(" Anna rivienmaara sivulla", "Sivuntulostus", 30, Type:=1)
    If Sivunkoko = 0 Then Exit Sub
    If Not Sivunkoko > 0 Then
    MsgBox "Sinun on annettava 0 suurempi luku!"
    GoTo takaisin
    End If
    Rivit = ActiveSheet.UsedRange.Rows.Count
    ActiveSheet.ResetAllPageBreaks
    If Rivit > Sivunkoko Then
    Sivunvaihto = Int(Rivit / Sivunkoko) + 1
    For i = 1 To Sivunvaihto
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveSheet.UsedRange.Cells(Sivunkoko * i + 1, 1)
    Next i
    End If
    alkuwb = ActiveWorkbook.Name
    Sivunalku = "$A$1"

    For i = 1 To ActiveSheet.HPageBreaks.Count
    uusi = i
    If i > 1 Then Sivunalku = ActiveSheet.HPageBreaks(i - 1).Location.Address
    j = ActiveSheet.HPageBreaks(i).Location.Row - 1

    Workbooks.Add
    uusiwb = ActiveWorkbook.Name
    Workbooks(alkuwb).Sheets(1).Range(Sivunalku & ":" & "$H$" & Trim$(Str$(j))).Copy _
    Destination:=Workbooks(uusiwb).Sheets(1).Range("A1") ' oletus eka taulukko
    Polku = "H:\" & uusi & ".xls" 'muuta polkua
    ActiveWorkbook.SaveAs Filename:=Polku
    ActiveWorkbook.Close
    Windows(alkuwb).Activate

    Next
    ' vika sivu lisattava manuaalisesti
    If j < Rivit Then
    uusi = uusi + 1
    j = j + Sivunkoko
    Sivunalku = Range(Sivunalku).Offset(Sivunkoko, 0).Address
    Workbooks.Add
    uusiwb = ActiveWorkbook.Name
    Workbooks(alkuwb).Sheets(1).Range(Sivunalku & ":" & "$H$" & Trim$(Str$(j))).Copy _
    Destination:=Workbooks(uusiwb).Sheets(1).Range("A1") ' oletus eka taulukko
    Polku = "H:\" & uusi & ".xls" 'muuta polkua
    ActiveWorkbook.SaveAs Filename:=Polku
    ActiveWorkbook.Close
    Windows(alkuwb).Activate
    End If
    virhe:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub


    keep Excelling
    @Kunde
  20. pelkillä boolean operaattoreilla ja on helppolukuisempi ja ei ole sitä jossien 7 sisäkkäissääntoä (ennen versiota 2007)

    =(B3*0,25*A5*G13)*((A3>=5)*0,2+(A3>=10)*0,1+(A3>=15)*0,1+(A3>=20)*0,1+(A3>=25)*0,1)
    21. 62 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt