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

1377

  1. " Käsittääkseni koodin piti osata ohittaa rivit, joihin ei ole liittää kuvaa vai ymmärsinkö oikein?"
    et...
    nyt poistaa solusta kommentin jos on ja lisää sitten uuden, muuten lisää vaan kommentin ja virhe voi syntyä jos kuvaa ei löydy

    koodissa ei olenyt mitään virhetarkastelua kuvanpuuttumiselle ja siksi herjaa
    helpoimmalla pääsee kun lisää vaan On Error Resume Next koodiin seuraavasti

    Option Explicit

    Sub LisääKuvaKommenttiin()
    Dim vika As Long
    Dim solu As Range
    On Error Resume Next
    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
  2. eipähän ole tommosta toimintaa vanhemmissa Excelissä....
    ja vot on hyvä ja kertoo mitenkä hän sen tekee 2003 versiossa ilman makroa?
  3. enpäs laitakaan makroa ;-)
    soluihin kaavat
    10-13
    =SUMPRODUCT(($A$1:$A$26>=TIME(10;0;0))*($A$1:$A$26=TIME(14;0;0))*($A$1:$A$26
  4. esim.
    .Attachments.Add "E:\" & Range("A1")&Range("A2")&".pdf"
  5. 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
  6. 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
  7. 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
  8. onnistuuhan toi helpostikin, mutta riippuu siitä mikä versio on käytössä ja millä ohjelmalla .pdf tallennus tehdään
  9. toimii valinnalla eli voit valita solun , yksittäisiä soluja alueita tai sitten klikkaat rivi- tai sarkevalitsinta, jolloin suorittaa koko riville tai sarakkeelle
  10. 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
  11. 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ää
  12. 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
  13. windowsin ohjauspaneeli aika,kieli ja alueasetuksista
    tai sitten VBA:lla
  14. 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
  15. 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
  16. 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
  17. 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
  18. 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
  19. 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
  20. 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
    21. 26 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt