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. esim.
    .Attachments.Add "E:\" & Range("A1")&Range("A2")&".pdf"
  2. fiksuintahan ne on laittaa kommenttiin ja homma hoituu sekunneissa alla olevalla makrolla tai
    varmaan muutaman kymmenen manuaalisesti lisätyn kuvan jälkeen makroa alat kaipaamaan...

    nyt nimet sarakkeessa C ja kuvat samassa kansiossa mihin tallennat Excel tiedoston.
    Hakee sitten kansiosta solun kommenttin solussa olevan nimen perusteella kuvan( eli jos solussa Matti Meikäläinen hakee kansiosta kuvan Matti Meikäläinen.jpg).
    Kuvan kokoa voit säädellä ja helppo muutella muutenkin tarpeisiin sopivaksi

    Option Explicit

    Sub LisääKuvaKommenttiin()
    Dim vika As Long
    Dim solu As Range

    vika = Range("C65536").End(xlUp).Row
    For Each solu In Range("C1:C" & vika)
    If Not solu.Comment Is Nothing Then solu.Comment.Delete
    With solu
    .AddComment
    .Comment.Visible = False
    .Comment.Shape.Fill.UserPicture ThisWorkbook.Path & "\" & solu & ".jpg"
    .Comment.Shape.Height = 300
    .Comment.Shape.Width = 300
    End With
    Next
    End Sub

    Keep EXCELing
    @Kunde
  3. vaihda salasana sopivaksi.
    thisWorkbook moduuliin...

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim salasana As String
    If Not InputBox("Anna salasana tallennukseen", "Salasanalla tallennus") = "kunde" Then
    MsgBox "salasana väärä, et voi tallentaa!", vbInformation
    Cancel = True
    Else

    End If

    End Sub

    Keep EXCELing
    @Kunde
  4. muuta hakusolu ja tiedostonpolku oikeaksi.
    moduuliin...

    Sub sähkäri()
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
    .To = Range("F1")
    .Subject = "Guru vastaa..."
    .Body = "ollako vaiko olla guru?" & vbNewLine & vbNewLine & "Keep EXCELing" & vbNewLine & "@Kunde"
    .Attachments.Add "E:\koe.pdf"
    .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    End Sub

    Keep EXCELing
    @Kunde
  5. onnistuuhan toi helpostikin, mutta riippuu siitä mikä versio on käytössä ja millä ohjelmalla .pdf tallennus tehdään
  6. toimii valinnalla eli voit valita solun , yksittäisiä soluja alueita tai sitten klikkaat rivi- tai sarkevalitsinta, jolloin suorittaa koko riville tai sarakkeelle
  7. Option Explicit

    Sub Muuta()
    Dim solu As Range
    Selection.NumberFormat = "General"
    ' 2 desimaalilla
    ' Selection.NumberFormat = "0.00"
    For Each solu In Selection
    If Not solu = "" Then
    solu = Val(solu)
    End If
    Next
    End Sub
  8. olen silloin tällöin Wordiinkin kirjoitellut koodia, mutta siinä Wordissä on aika hankalaa tehdä juttuja ja se ei oikein taivu kaikkeen, joten helpommalla pääsee Excelissä.
    Jos tarvetta on niin Exceliin voi hakea Wordin hyviä ominaisuuksia kuten esim.oikoluku.
    Mieluummin käytänkin Exceliä erilaisten lomakkeiden tekoon ja lisään sitten tarvittavia työkaluja Wordistä....
    Aloita opiskelusi nauhoittamalla makroja ja katso mitä se aikaan (90% paskaa...) ja yritä sitten siistiä koodia.
    Helpistä löytyy koodinpätkiä ja nettihän on niitä pullollaan ja tälläkin palstalla satoja ja satoja koodin pätkää
  9. laittaa yleisen muotoilun valituille soluille. Helppo muuttaa milsi muulsi muotoiluksi kanssa
    valitse muokattavat solut ja suorita koodi...

    Option Explicit

    Sub Muuta()
    Dim solu As Range
    Selection.NumberFormat = "General"
    For Each solu In Selection
    solu = Val(solu)
    Next
    End Sub

    Keep EXCELing
    @Kunde
  10. windowsin ohjauspaneeli aika,kieli ja alueasetuksista
    tai sitten VBA:lla
  11. kopioi/liitä tiedot Exceliin esim. nyt soluun A1 ( jolloin tiedot on allekkain A-sarakkeessa)
    suorita allaoleva makro Excelissä ja homma klaarattua muutamassa sekunnissa...

    moduuliin...
    oletuksena viestin malli


    Option Explicit

    Sub Järjestä()
    Dim vika As Long
    Dim i As Long
    vika = Range("A65536").End(xlUp).Row + 1
    Range("A1").Select
    For i = 4 To vika Step 4
    ActiveCell.Offset(0, 1) = ActiveCell.Offset(1, 0)
    ActiveCell.Offset(0, 2) = ActiveCell.Offset(2, 0)
    ActiveCell.Offset(1, 0) = ""
    ActiveCell.Offset(2, 0) = ""
    ActiveCell.Offset(4, 0).Select
    Next
    Range("A1:A" & vika).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End Sub

    Keep EXCELing
    @Kunde
  12. moduuliin...

    Option Explicit
    'vanhat nimet sarake A
    'uudet nimet sarake B
    'tiedostopääte .jpg

    Sub UudelleenNimeä()
    Dim vika As Long
    Dim vanha As String
    Dim uusi As String
    Const POLKU As String = "E:\Testi\"
    vika = Range("A65536").End(xlUp).Row
    On Error Resume Next
    vanha = Dir(POLKU)
    Do While vanha ""
    Debug.Print vanha
    If UCase(Right$(vanha, 3)) = "JPG" Then
    uusi = EtsiJaSiirrä(vanha, Columns("A:A")).Offset(0, 1)
    If Not uusi = "" Then
    Name POLKU & vanha As POLKU & uusi
    End If
    End If
    vanha = Dir
    Loop
    End Sub

    Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range
    Dim solu As Range
    Dim EkaOsoite As String
    Worksheets("Kuvat").Activate
    With HakuAlue
    Set solu = .Find( _
    What:=Hakuehto, _
    LookIn:=xlValues, _
    LookAt:=xlWhole, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False, _
    SearchFormat:=False)
    If Not solu Is Nothing Then
    Set EtsiJaSiirrä = solu
    EkaOsoite = solu.Address
    Do
    Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
    Set solu = .FindNext(solu)
    Loop While Not solu Is Nothing And solu.Address EkaOsoite
    End If
    End With
    End Function

    Keep EXCELing
    @Kunde
  13. ko. taulukon moduuliin...

    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)
    Range("B4:M4").Interior.ColorIndex = xlNone
    Range("B4:M4").Find(Application.WorksheetFunction.Max(Range("B4:M4"))).Interior.ColorIndex = 5
    Range("B4:M4").Find(Application.WorksheetFunction.Min(Range("B4:M4"))).Interior.ColorIndex = 3
    End Sub

    Keep EXCELing
    @Kunde
  14. amatöörien puuhastelua...

    ota kameralla kuva tarvittavasta alueesta ja liitä se tyhjään taulukkoon ja toista kaikille tulostettaville taulukoille.
    päivittyy solumuutokset ja rivien lisäykset automaattisesti

    Keep EXCELing
    @Kunde
  15. lisärajoitteita...
    ei löydä kuin yhden esiintymän- yleensä ensimmäisen...
    toki kikkailemalla asiaa voi parannella
    VBA:lla toi oli piece of cake, ja löytää kaikki osittaisellakin vastineella, nyt tossa esim. koodissani tosin ei ole osavastinetta, mutta ei siihen tartte kuin vaihtaa
    LookAt:=xlWhole --->LookAt:=xlPart

    Keep EXCELing
    Kunde
  16. Option Explicit

    Sub koe()
    Dim vika As Long
    Dim solu As Range

    Range("T2:U2").HorizontalAlignment = xlCenter

    vika = Range("T65536").End(xlUp).Row
    For Each solu In Range("T1:T" & vika)
    Select Case True
    Case solu Like "*reiska*"
    solu.Offset(0, 1) = "kova sälli"
    Case solu = "vanhaatekstiä2"
    solu.Offset(0, 1) = "uuttatekstiä2"
    Case solu = "vanhaatekstiä3"
    solu.Offset(0, 1) = "uuttatekstiä3"
    Case Else
    solu.Offset(0, 1) = "Virhe!"
    End Select
    Next
    End Sub

    Keep EXCELing
    @Kunde
  17. Sub koe()
    Dim vika As Long
    Dim solu As Range

    Range("T2:U2").HorizontalAlignment = xlCenter

    vika = Range("T65536").End(xlUp).Row
    For Each solu In Range("T1:T" & vika)
    Select Case solu
    Case "vanhaatekstiä1"
    solu.Offset(0, 1) = "uuttatekstiä1"
    Case "vanhaatekstiä2"
    solu.Offset(0, 1) = "uuttatekstiä2"
    Case "vanhaatekstiä3"
    solu.Offset(0, 1) = "uuttatekstiä3"
    Case Else
    solu.Offset(0, 1) = "Virhe!"
    End Select
    Next
    End Sub
  18. Excelistä tuo työkalu puuttuu...(voi olla 2010, mutta ei sitä aikaisemmissa versioissa ainakaan ole)

    Koodillakin paska duunata, kun pitäisi tietää muokattava merkki solussa ja se ei ole helppoa. Koko solun muokkaus sensijaan piece of the cake, mutta siitähän nyt ei ollutkaan kyse.
    Toki aktiivisen solun merkit voisi kopioida lomakkeelle ja sitten muokata valittuja merkkejä yksitellen ja lopuksi palauttaa takaisin muokattuna aktiiviseen soluun, mutta työlästä työlästä...
  19. moduuliin...
    muuta hakusolu=K1 ja hakualue= A1:D10 sopiviksi

    Function EtsiiKaikkiAlueelta(Hakuehto As Variant, HakuAlue As Range) As String
    Dim solu As Range
    Dim EkaOsoite As String
    Worksheets("Sheet1").Activate
    With HakuAlue
    Set solu = .Find( _
    what:=Hakuehto, _
    LookIn:=xlValues, _
    LookAt:=xlWhole, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False, _
    SearchFormat:=False)
    If Not solu Is Nothing Then
    EkaOsoite = solu.Address
    Do
    EtsiiKaikkiAlueelta = EtsiiKaikkiAlueelta & ", " & solu.Address
    Set solu = .FindNext(solu)
    Loop While Not solu Is Nothing And solu.Address EkaOsoite
    End If
    End With
    EtsiiKaikkiAlueelta = Right(EtsiiKaikkiAlueelta, Len(EtsiiKaikkiAlueelta) - 1)
    End Function

    Sub Etsi()
    Dim solut As String
    On Error GoTo virhe
    solut = EtsiiKaikkiAlueelta(Range("K1"), Range("A1:D10"))
    MsgBox Range("K1") & " löytyi solu(i)sta" & solut
    Exit Sub
    virhe:
    MsgBox "ei löytynyt!"
    End Sub

    Keep EXCELing
    @Kunde
  20. onhan siinä paljonkin vikaa...
    ei toi tee muuta kuin tulostaa... eli tietenkin kysyy polkua jne.
    eikä koodisa ole mitään sähkärin lahettämistäkään-ei nauhuri nauhoita noita juttuja...

    vaatii koodaajaa...

    ,-) Kunde
    21. 26 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt