Makro og VBA - Ændring af valutabetegnelsen skal ændre summen.

Print side | Luk vindue

Ændring af valutabetegnelsen skal ændre summen.

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=305
Udskrevet den: 23.Nov.2024 kl. 16:17

Emne: Ændring af valutabetegnelsen skal ændre summen.

Besked fra: Gogo
Emne: Ændring af valutabetegnelsen skal ændre summen.
Posteringsdato: 01.Apr.2011 kl. 16:56

Hejsa....

Jeg vil meget gerne have hjælp til følgende og jeg håber nogen af jer kan hjælpe.

A1 B1

100 Eur

I A1 skal jeg taste det beløb jeg har modtaget. I dette tilfælde har jeg modtaget 100.

I B2 skal jeg via dropdown menu vælge mellem flere valutaer. I dette tilfælde har jeg valgt eur.

Nu vil jeg gerne have den til at omregne værdien til dkk. Dvs at det nu kommer til at stå 750 i A1

Altså udfra hvilken valuta jeg vælger i B1 skal den A1 ændre værdien. Jeg håber i kan forstå mig, men jeg tror måske vi skal have en makro til alt det her.

Håber at høre fra nogle kloge hoveder Smile

Gogo

Svar:

Besked fra: Allan
Posteringsdato: 01.Apr.2011 kl. 21:22

Hej Gogo,

Hvis du vil have både input og output i samme celle, skal du bruge en makro.

Denne makro aktiveres når du taster i A1, og konverterer A1 til den valuta som er angivet i B1.

Du kan selv tilføje flere valutaer hvis du ønsker det.

Indsæt koden på det ark som skal indeholde funktionen. (Højreklik på fanen, 'Vis programkode')

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$1" Then
Application.EnableEvents = False
Select Case Range("B1")

        Case "EUR"
            Target.Value = Target.Value * 7.5

        Case "SEK"
            Target.Value = Target.Value * 0.83

        Case "USD"
            Target.Value = Target.Value * 5.27

        Case "GBP"
            Target.Value = Target.Value * 8.46

    End Select
Application.EnableEvents = True
End If

End Sub

Overvej hvad arket skal gøre hvis du først taster i A1 og derefter ændrer valutaen i B1.

//Allan

Besked fra: Gogo
Posteringsdato: 01.Apr.2011 kl. 22:26

Du er en gutter mand Allan...

Jeg vil faktisk heller have at jeg først taster beløbet, hvor efter jeg ændre valutaen.

Kan det lade sig gøre?

Og for at helt besværlig, kan talene i beløbet godt ændre farve efter de er blevet omregnet? På den måde ved jeg at omregningen har fundet sted.

Gogo

Besked fra: Allan
Posteringsdato: 01.Apr.2011 kl. 23:24

Sagtens, farven bliver grøn når valutaen ændres.

Hvis du ændrer selve beløbet, bliver tallet sort igen.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$1" Then Range("A1").Font.ColorIndex = xlAutomatic

If Target.Address = "$B$1" Then
Application.EnableEvents = False
Range("A1").Font.ColorIndex = 14
Select Case Target

        Case "EUR"
            Range("A1").Value = Range("A1").Value * 7.5

        Case "SEK"
            Range("A1").Value = Range("A1").Value * 0.83

        Case "USD"
            Range("A1").Value = Range("A1").Value * 5.27

        Case "GBP"
            Range("A1").Value = Range("A1").Value * 8.46

    End Select
Application.EnableEvents = True
End If

End Sub

Besked fra: Gogo
Posteringsdato: 02.Apr.2011 kl. 17:20

Det er gludkorn det her Allan... :)

Jeg har tænkt over følgende tankte:

Kan denne kode laves:?

Hvis jeg dobbeltklikker på en celle, så skal der dukke et popup (intupbox/msgbox) op, hvor jeg der er 2 frie rubrikker.

I den ene skal der tastes beløb og i det andet kan man vælge mellem de forskellige valutaer. Efter man har udfyldt de tomme rubrikker, skal man trykke på ok, hvor efter værdien bliver indsat i den celle man dobbeltklikkede på.

Giver det mening? Det ville være super, hvis man kunne lave noget af den slags.

Gogo

Besked fra: Allan
Posteringsdato: 02.Apr.2011 kl. 22:25

Gogo, alt kan lade sig gøre i Excel, alt

Se denne fil, indeholder den ikke hvad du ønsker?

uploads/1/ValutaOmregner.xls - uploads/1/ValutaOmregner.xls

//Allan

Besked fra: Gogo
Posteringsdato: 03.Apr.2011 kl. 08:50

Det er super Allan. Det er lige det jeg skulle bruge.... :)

Det er godt nok imponerende, hvad du er i stand til med Excel.

Jeg er også igang med at søge efter en bog, som kan hjælpe med VBA programmering, men indtil da, er det super med jeres hjælp... :) Jeg vender tilbage, hvis jeg skal have hjælp til noget mere.

Besked fra: Gogo
Posteringsdato: 03.Apr.2011 kl. 16:20

Hvordan kopiere jeg denne kode, altså den hele samt med comboxen osv...

Jeg skal sætte den ind i mit eget ark og der har jeg rigtig mange faner.

Besked fra: Allan
Posteringsdato: 03.Apr.2011 kl. 22:20

Hej Gogo,

Åben filen fra denne tråd og din egen fil.

Træk (Med musen) userformen 'ValutaForm' ned i din egen fil.

I ThisWorkbook skal denne kode ligge:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
ValutaForm.Show
End Sub

Så burde det virke hos dig.

//Allan

Besked fra: Gogo
Posteringsdato: 04.Apr.2011 kl. 18:35

Super. Det virker... :)

Så er det sidste ting jeg skal have på plads inden jeg er færdig med denne tråd.

Jeg vil gerne have at det kun skal være muligt at bruge denne kode i ark1 til ark10 og kun i cellerne c20.

Kan det lade sig gøre?

Gogo

Besked fra: Allan
Posteringsdato: 04.Apr.2011 kl. 19:27

Ja da, sådan:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Int(Replace(ActiveSheet.CodeName, "Ark", "", 1)) <= 10 Then
If Target.Address = "$C$20" Then ValutaForm.Show
End If
End Sub

Bemærk at scriptet responderer på arkets CodeName, som er det navn som er vist i VBA-editoren.
På denne måde sikres arket mod omdøbning af arkfanerne.
Det fungerer ved at koden tager arkest CodeName, fjerner "Ark" så der kun er et tal tilbage.

Hvis dette tal er mindre eller lig med 10 vises ValutaFormen.

Hvis du hellere vil bruge navnet på selve fanenen, skal du i erstatte CodeName med Name

Håber det kan bruges

//Allan

Besked fra: Gogo
Posteringsdato: 04.Apr.2011 kl. 19:32

Jep.

Men mine ark har forskellige navne. De hedder ikke ark 1 osv.

Hvordan så?

Besked fra: Allan
Posteringsdato: 04.Apr.2011 kl. 20:06

Du skrev at Ark1 til Ark10 skulle aktivere koden !!!

Hvis du trykker ALT+F11 vil du kunne se CodeName på arkene, det er som regel Ark1, 2 3 osv.

Vil du, som du skriver, bruge arkfanernes navnet direkte, skal du bruge denne kode:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If ActiveSheet.Name = "Ark1" Or _
    ActiveSheet.Name = "Ark2" Or _
    ActiveSheet.Name = "Ark3" Or _
    ActiveSheet.Name = "Ark4" Or _
    ActiveSheet.Name = "Ark5" Or _
    ActiveSheet.Name = "Ark6" Or _
    ActiveSheet.Name = "Ark7" Or _
    ActiveSheet.Name = "Ark8" Or _
    ActiveSheet.Name = "Ark9" Or _
    ActiveSheet.Name = "Ark10" Then
    If Target.Address = "$C$20" Then ValutaForm.Show
End If
End Sub

Du skal naturligvis ændre de forskellige arknavne til det korrekte.

//Allan

Besked fra: Gogo
Posteringsdato: 04.Apr.2011 kl. 21:13

Jeg ved det... Kom til at formulere mig lidt forkert.

Nu til det sidste, så stopper jeg.

Jeg har fået det til at fungere fint, men....

Istedet for c20, vil jeg nu gerne have koden til at fungere i (f7:s7) og (f8:s8)

Jeg er sku lidt besværlig nu...

Besked fra: Allan
Posteringsdato: 04.Apr.2011 kl. 21:34

He he, det går nu nok

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If ActiveSheet.Name = "Ark1" Or _
    ActiveSheet.Name = "Ark2" Or _
    ActiveSheet.Name = "Ark3" Or _
    ActiveSheet.Name = "Ark4" Or _
    ActiveSheet.Name = "Ark5" Or _
    ActiveSheet.Name = "Ark6" Or _
    ActiveSheet.Name = "Ark7" Or _
    ActiveSheet.Name = "Ark8" Or _
    ActiveSheet.Name = "Ark9" Or _
    ActiveSheet.Name = "Ark10" Then
    If Target.Column >= 6 And Target.Column <= 19 And Target.Row >= 7 And Target.Row <= 8 Then ValutaForm.Show
End If
End Sub

//Allan

Besked fra: Gogo
Posteringsdato: 04.Apr.2011 kl. 22:19

Hjælp Allan!!

Jeg er igang med at indtaste 80 ark i koden som gav mig ovenover.

Men så kom denne meddelelse frem:

To many line continautions

Kan jeg ikke taste så mange ark og hvad gør jeg så??

Gogo

Besked fra: Allan
Posteringsdato: 05.Apr.2011 kl. 22:22

Hej Gogo,

Som skrevet, brug CodeName.

Se her:

I følgende eksempel har filen 3 arkfaner med fanenavnene, Forside, Budget og Realiseret.

CodeName er for de 3 ark, Ark1, Ark2 og Ark3.

Min tidligere fremsendte kode bruger dette CodeName og ikke fanens navn.

Jeg har med gult, fremhævet CodeName og hvor det ændres.

Hvis du uploader din fil her til forummet, skal jeg nok ændre din fil så den virker.

Hvis du IKKE vil bruge CodeName, kan du alternativt bruge denne metode.

Metoden kræver at du tæller dine ark.

1 er arket længst mod venstre.

Denne kode vil aktivere din funktion på de 40 første ark fra venstre mod højre.

Du kan selv ændre dette, ved at redigere StartIndex og SlutIndex.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
StartIndex = 1
SlutIndex = 40
If Sh.Index >= StartIndex And Sh.Index <= SlutIndex Then
If Target.Address = "$C$20" Then ValutaForm.Show
End If
End Sub

//Allan

Besked fra: Gogo
Posteringsdato: 06.Apr.2011 kl. 16:27

Super. Så virker som jeg vi have det.

Jeg brugte den sidste kode.

Mange tak for hjælpen og beklager jeg var så besværlig :)

Besked fra: Allan
Posteringsdato: 06.Apr.2011 kl. 17:57

Hej Gogo,

Besværlig.... nej nej, kritisk er nok et bedre ord, positivt ment.

Du skal i hvertfald have velbekomme, og tak for din tilbagemelding. Det var godt at det kom til at virke som det skal.

//Allan

Print side | Luk vindue