Příspěvky uživatele

KT je věc.
Jinak tady na webu je dobrý manuál pro ty co to neznají.

Tak takto.
Sub ProhozeniKomentaru()

Dim Adresy, Adresa1, Adresa2 As Variant
Dim Coment1, Coment2, HodnotaBunky1, HodnotaBunky2 As String

Adresy = Selection.Address

If InStr(1, Adresy, ":", 1) = 0 And Selection.Count = 2 Then
Adresa1 = Mid(Adresy, 1, InStr(1, Adresy, ",", 1) - 1)
Adresa2 = Mid(Adresy, InStr(1, Adresy, ",", 1) + 1, Len(Adresy) - InStr(1, Adresy, ",", 1))

If Range(Adresa1).Comment Is Nothing Then
Range(Adresa1).AddComment
End If
Range(Adresa1).Comment.Text _
Text:=Range(Adresa1).Comment.Text & Chr(10) & "- " & Application.UserName & Chr(10) & Range(Adresa1).Value & " " & Cells(Range(Adresa2).Row, "A")

If Range(Adresa2).Comment Is Nothing Then
Range(Adresa2).AddComment
End If
Range(Adresa2).Comment.Text _
Text:=Range(Adresa2).Comment.Text & Chr(10) & "- " & Application.UserName & Chr(10) & Range(Adresa2).Value & " " & Cells(Range(Adresa1).Row, "A")

'Coment1 = Range(Adresa1).Comment.Text
'Coment2 = Range(Adresa2).Comment.Text

'Range(Adresa1).Comment.Text Text:=Coment2
'Range(Adresa2).Comment.Text Text:=Coment1

HodnotaBunky1 = Range(Adresa1).Value
HodnotaBunky2 = Range(Adresa2).Value

Range(Adresa1).Value = HodnotaBunky2
Range(Adresa2).Value = HodnotaBunky1
End If
End Sub

Příloha by nebyla?

Pokud se mažou řádky je lepší je mazat od spodu.
For i = Rows.Count To 1 Step -1

Zde vzorec hledá na Listu1.
=KDYŽ(SVYHLEDAT(A3;List1!A:C;2;0)="okurka";SVYHLEDAT(A3;List1!A:C;3;0);"nenalezeno")

Určitě je to lepší,

dobrý postřeh.

Tak nejjednodušší by bylo asi toto.
Přidat řádek, že při chybě pokračuj dál

On Error Resume Next
'schovat ODDEDLIŤ vo fakture
Selection.Rows.Ungroup

Na jednom foru jsem mu na to udelal makro,
ješte se neozval zda tak či jinak.
Pro názornost ho dám i sem.
Sub ProhozeniKomentaru()

Dim Adresy, Adresa1, Adresa2 As Variant
Dim Coment1, Coment2 As String

Adresy = Selection.Address

If InStr(1, Adresy, ":", 1) = 0 And Selection.Count = 2 Then
Adresa1 = Mid(Adresy, 1, InStr(1, Adresy, ",", 1) - 1)
Adresa2 = Mid(Adresy, InStr(1, Adresy, ",", 1) + 1, Len(Adresy) - InStr(1, Adresy, ",", 1))

If Range(Adresa1).Comment Is Nothing Then
Range(Adresa1).AddComment
End if
Range(Adresa1).Comment.Text Text:="Owner:" & Chr(10) & Range(Adresa1).Value & " " & Cells(Range(Adresa1).Row, "A")

If Range(Adresa2).Comment Is Nothing Then
Range(Adresa2).AddComment
End if
Range(Adresa2).Comment.Text Text:="Owner:" & Chr(10) & Range(Adresa2).Value & " " & Cells(Range(Adresa2).Row, "A")

Coment1 = Range(Adresa1).Comment.Text
Coment2 = Range(Adresa2).Comment.Text

Range(Adresa1).Comment.Text Text:=Coment2
Range(Adresa2).Comment.Text Text:=Coment1
End If
End Sub

Pro excel 2007 je to příkaz
ActiveWorkbook.RefreshAll

Tak jsem dohledal na netu, že je to bug Excelu.

Když se ručně vleze do PF a potvrdí OK tak se to provede.
Bohužel jsem nikde nenašel jak to nějak obejít.

Jinak když zadáš do vyhledávače conditional formating tak najdeš spoustu věcí.

No tak na to koukni.

zas jsem chytřejší ohledně PF ve VBA

Hledej na netu Ganttův diagram

Ukázka třeba tady http://office.lasakovi.com/excel/grafy/ganttuv-diagram-excel/

Tak to chtělo vědět , že tam bude více PF.
No zkusím ještě něco když je tam více PF.

Teď mě napadlo, že kdyby toto pf bylo vždy poslední tak by šlo jich tam mít více,
počkám s čím přijdeš

Zdravím,
u mě se chová dobře.
Mejl se vytvoří a když ho pak zruším tak outlook běží dál.

Možná takto:

Sub PF_3barskala()
'
'smaze vsechny podminene formatovani na liste
Worksheets(1).UsedRange.FormatConditions.Delete

'vytvori podminene formatovani pro oblast ()
OblastPF = Worksheets(1).Range("A1")
With Worksheets(1).Range(OblastPF)

'podminene formatovani 3barevna skala
.FormatConditions.AddColorScale colorscaletype:=3
End With
End Sub

-Do A1 se napíše název oblasti
-na listě mít 1 podminene formatovani (vsechny se mazou)

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje