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
- ilmeisesti sulla on jo jo toi Worksheet_SelectionChange tapahtuma koodi siellä... joten lisää sitten toi koodi sinne ilman ekaa ja vikaa riviä
eli ilman näitä rivejä
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Zoom100 = 100
Zoom150 = 150
100 on normaali ja zoom150 =150 on nyt zoomaus 150% ja jos muutat
Zoom100 = 100
Zoom150 = 200 niin zoomaus 200%...
Keep EXCELing
@Kunde - ko. taulukon moduuliin...
toimii kaikilla soluilla, jossa kelpoisuustarkistus listalla....
muuta zoomiluvut sopiviksi
kuten olen aiemmin postannut, toimii kaikissa soluissa, missä kelpoisuustarkistus lista...
nyt zoomaa 150%, muuta Zoom150 arvoa isommaksi, jos tarttet isompaa zoomausta
ei muuta kuin ALT+F11 ja tuplaklikkaa vasemmalla ko.taulukon nimeä ja liität koodin ko. taulukon moduuliin oikealle tyhjään tilaan ja se on siinä
Keep EXCELing
@Kunde - ko. taulukon moduuliin...
toimii kaikilla soluilla, jossa kelpoisuustarkistus listalla....
muuta zoomiluvut sopiviksi
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Zoom100 As Long
Dim Zoom150 As Long
Dim Datatyyppi As Long
Zoom100 = 100
Zoom150 = 150
Application.EnableEvents = False
On Error Resume Next
Datatyyppi = Target.Validation.Type
On Error GoTo Virhe
If Datatyyppi = 3 Then
If ActiveWindow.Zoom Zoom150 Then
ActiveWindow.Zoom = Zoom150
End If
Else
If ActiveWindow.Zoom Zoom100 Then
ActiveWindow.Zoom = Zoom100
End If
End If
Poistu:
Application.EnableEvents = True
Exit Sub
Virhe:
GoTo Poistu
End Sub
Keep EXCELing
@Kunde - vaihda tapahtumaa ja tsekkaa kaavan tulosta...
Private Sub Worksheet_Calculate()
If Range("B8").Value = 0 Then
'koodi tähän
End If
End Sub
Keep EXCELing
@Kunde - jos tiedot esim. A1:A100000, niin tee soluun B1 kaava
=OFFSET($A$1;(ROW()-1)*5;0) ja ENTER
sitten aktivoi solu B1 ja tuplaklikkaa sitä pientä mustaa neliötä solun oikeassa alakulmassa ja homma sillä siisti...
Keep EXCELing
@Kunde - siis solualue lomille on B2:X40 ja sen toi sun makrosi tekee PDF:ksi.
Mitä sitten haluat tallentaa seuraavaksi esim B41:X78- ehkä?
Aktiivisesta näytöstä tietyt solut alas ja oikealle (vasen yläkulma solusta tietyt kpl määrät) suuntaansa -ehkä?
EXCEL taipuu kyllä lähes mihin vaan kun tiedetään tarpeet... - soluissa kaavat
A1=TÄMÄ.PÄIVÄ()
B1=VALITSE.INDEKSI(VIIKONPÄIVÄ(A1);"kirkko";"liikuntaryhmä";"taidepaja";"teatteri";"koripallo";"jääkiekko";"sauna") - Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Solualue As Range
If Target.Count = 1 Then
Set Solualue = Range("E5:JX5")
For i = 7 To 33 Step 2
Set Solualue = Union(Solualue, Range("E" & i & ":JX" & i))
Next
If Not Intersect(Target, Range(Solualue.Address)) Is Nothing Then
If Target.Interior.Color = vbGreen Then
Target = ""
Target.Interior.Pattern = xlNone
Else
Target.Interior.Color = vbGreen
Target = "X"
Target.HorizontalAlignment = xlCenter
End If
End If
End If
End Sub
Keep EXCELing
@Kunde - mä arvasin tän sun tulevan kyssärin ;-)
tottahan toki se onnistuu helposti...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Solualue As Range
If Target.Count = 1 Then
Set Solualue = Range("E5:JX5")
For i = 7 To 33 Step 2
Set Solualue = Union(Solualue, Range("E" & i & ":JX" & i))
Next
If Not Intersect(Target, Range(Solualue.Address)) Is Nothing Then
If Target.Interior.Color = vbGreen Then
Target.Interior.Pattern = xlNone
Else
Target.Interior.Color = vbGreen
End If
End If
End If
End Sub
Keep EXCELing
@Kunde - ihan sama mikä kunhan tiedot samassa järjestyksesä . Vaikka pelkkä tekstitiedosto, vaikkapapilkulla tai puolipisteellä erottelee kentät.
Ei se sen kummempi tartte olla - VBA...
hakua peliin
useita etsijasiirrä etsijakopioi ja vastaavia esimerkkejä mun tekemänä tällä foorumilla - Sub Testi()
Dim fso As New FileSystemObject
fso.CopyFolder "X:\HAKEMISTO 1", "X:\Huuhaa"
fso.CopyFolder "X:\Huuhaa", "X:\HAKEMISTO 1\BACKUP"
fso.DeleteFolder "X:\Huuhaa"
End Sub - referensseissä lisää Microsoft Scripting Runtime viittaus....
- referensseissä lisää Microsoft Scripting Runtime viittaus
Sub Testi()
Dim fso As New FileSystemObject
fso.CopyFolder "X:\HAKEMISTO 1", "X:\HAKEMISTO 1/BACKUP"
End Sub
Keep EXCELing
@Kunde - =OR(A1=4300;A1=4301;A1=28472;A1=28481 )*(A2/A3)/24
Keep EXCELing
@Kunde - 2010 vaiko 2013 versiossa muutui salasanat kryptatuiksi, joten ei oo helppoa keinoa lienee enää. Tarjolla on kaupallisia ohjelmia, millä noi salasanat saa selvitettyä ilmeisesti uusimmastakin versioista,
- ei avaa oikealla salasanalla vaan "sopivalla", Sitten voit suojata uudella salasanalla ja apanna sen visusti talteen ;-)
Sub Suojauksenpoisto()
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim n As Integer
Dim a1 As Integer
Dim a2 As Integer
Dim a3 As Integer
Dim a4 As Integer
Dim a5 As Integer
Dim a6 As Integer
On Error Resume Next
For a = 65 To 66
For b = 65 To 66
For c = 65 To 66
For d = 65 To 66
For e = 65 To 66
For a1 = 65 To 66
For a2 = 65 To 66
For a3 = 65 To 66
For a4 = 65 To 66
For a5 = 65 To 66
For a6 = 65 To 66
For n = 32 To 126
ActiveSheet.Unprotect Chr(a) & Chr(b) & Chr(c) & Chr(d) & Chr(e) & Chr(a1) & Chr(a2) & Chr(a3) & Chr(a4) & Chr(a5) & Chr(a6) & Chr(n)
If ActiveSheet.ProtectContents = False Then Exit Sub
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
End Sub
Keel EXCELing
@Kunde - Sub HaeTaulukonArvot()
Dim X As Object
Dim laskuri As Integer
'muuta taulukon nimi sopivaksi
Worksheets("Sheet2").Cells = ""
Worksheets("Sheet2").Range("A1") = "X"
'muuta taulukon nimi sopivaksi
With Worksheets("Sheet2")
.Range(.Cells(2, 1), .Cells(UBound(ActiveChart.SeriesCollection(1).Values) 1, 1)) = Application.Transpose(ActiveChart.SeriesCollection(1).XValues)
End With
laskuri = 2
For Each X In ActiveChart.SeriesCollection
'muuta taulukon nimi sopivaksi
Worksheets("Sheet2").Cells(1, laskuri) = X.Name
'muuta taulukon nimi sopivaksi
With Worksheets("Sheet2")
.Range(.Cells(2, laskuri), .Cells(UBound(ActiveChart.SeriesCollection(1).Values) 1, laskuri)) = Application.Transpose(X.Values)
End With
laskuri = laskuri 1
Next
End Sub
Keep EXCELing
@Kunde - jos tarkoitat omaa listaa lajittelussa, niin tallenna lista(solualue, missä lajittelukriteeri omaksi luetteloksi) ja käytä sitä sitten lajittelussa?
Keep EXCELing
@Kunde - jos sinulla on solussa hyperlinkki niin EXCEL aukaisee sen oletusselaimella ja mitä sitten sivun aukeamisen jälkeen tapahtuu ei ole EXCElistä kiinni.
Eli jos haluat sen toimivan ilman salasanojen syöttöä tarvitsee tutkailla sivun rakennetta. Jos siellä esim,. lomake mihin syötetään tiedot niin etsiä lomakkeen nimi ja sitten lomakkeelta nimet salasana ja tunnus kentille...
sitten muutama rivi koodia VBA:lla ja se on siinä ;-)
no ei nyt ihan noin helppoa käytännössä, mutta sivun rakenteista vaikeusaste riippuu
Keep EXCELing
@Kunde