< návrat zpět

MS Excel


Téma: zoom rss

Zaslal/a 17.12.2022 18:27

dobrý den, hledal jsem na netu a bez úspěchu. mám několik obrazců(obdelník ...) a potřeboval bych aby se při najetí myši obrazec zvětšil třeba o 50% a nebo aby se zobrazil popis. díky za radu nebo nasměřování jak na to

Příloha: jpg54119_1111111.jpg.jpg (75kB, staženo 38x)
54119_1111111.jpg.jpg
Zaslat odpověď >

#054149
avatar
vyřešeno a ani to tak složité nebylocitovat
#054150
avatar

fortes napsal/a:

vyřešeno a ani to tak složité nebylo

Skrátka si macher. 10citovat
#054159
avatar
dotaz, našel jsem na webu toto makro. jen jsem upravit že ty obdélníky změní průhlednost což funguje, ale i v ten okamžik ztrácí info o RGB, tak když vrátím průhlednost opět na 100% (.Transparency = 0) už to má pouze jednu barvu. jde nejak ošetřit zachování RGB ?

Sub testDeleteInsertedShapes()
Dim ws As Worksheet, sh As Shape, shR As ShapeRange, rng As Range
Set ws = ActiveSheet
Set rng = ws.Range(ws.Range("A18"), ws.Cells(15, Columns.Count))

Application.EnableEvents = False
For Each sh In ws.Shapes
If sh.Type = 1 Then 'rounded rectangles
If Not Intersect(sh.TopLeftCell, rng) Is Nothing Then
If sh.TextFrame2.TextRange.Text = "Resize" Or _
sh.TextFrame2.TextRange.Text = "Clear All" Then
sh.Delete

End If
Else
sh.Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 1
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = -0.5
.ForeColor.Brightness = 0
.Transparency = 1
End With
End If
End If
Next
Application.EnableEvents = True
End Sub

výsledek funguje

Private Sub ComboBox1_Change()
Set zacatek = Worksheets("zaklad").Range("c10:d1000").Find("V karta")
rad1 = (zacatek.Row)

Set konec = Worksheets("zaklad").Range("c10:c1000").Find("SUMÁŘ")
rad2 = (konec.Row)

Worksheets("zaklad").Cells(rad1 + 7, 6).Resize(rad2 - rad1 - 1, 1).Font.ColorIndex = 1

Dim ws As Worksheet, sh As Shape, shR As ShapeRange, rng As Range
Set ws = ActiveSheet
Set rng = ws.Range(ws.Range("A18"), ws.Cells(15, Columns.Count))
If Worksheets("data").Cells(11, 6) = "TEXT" Then
zobraz = False
Worksheets("zaklad").Cells(rad1 + 7, 6).Resize(rad2 - rad1 - 1, 1).Font.ColorIndex = 1
Else
Worksheets("zaklad").Cells(rad1 + 7, 6).Resize(rad2 - rad1 - 1, 1).Font.ColorIndex = 2
zobraz = True
End If
Application.EnableEvents = False
For Each sh In ws.Shapes
If sh.Type = 1 Then 'rounded rectangles
If Not Intersect(sh.TopLeftCell, rng) Is Nothing Then
If sh.TextFrame2.TextRange.Text = "Resize" Or _
sh.TextFrame2.TextRange.Text = "Clear All" Then
shp.Visible = zobraz
End If
Else
sh.Visible = zobraz
End If
End Ifcitovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09