kunde

kunde profiilikuva
Joulu 2024
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

Liittynyt 20v sitten
7 aloitusta · 1377 kommenttia
Uusimmat aloituksetSuosituimmat aloituksetUusimmat kommentit
" 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
eipähän ole tommosta toimintaa vanhemmissa Excelissä....
ja vot on hyvä ja kertoo mitenkä hän sen tekee 2003 versiossa ilman makroa?
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
esim.
.Attachments.Add "E:\" & Range("A1")&Range("A2")&".pdf"
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
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
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
onnistuuhan toi helpostikin, mutta riippuu siitä mikä versio on käytössä ja millä ohjelmalla .pdf tallennus tehdään
toimii valinnalla eli voit valita solun , yksittäisiä soluja alueita tai sitten klikkaat rivi- tai sarkevalitsinta, jolloin suorittaa koko riville tai sarakkeelle
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
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ää
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
windowsin ohjauspaneeli aika,kieli ja alueasetuksista
tai sitten VBA:lla
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
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
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
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
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
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
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
26 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt