kunde
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 sitten
Muokkaa profiilia7 aloitusta · 1377 kommenttia
- " 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