VBA z buňky do komentáře Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Majk1976
nováček
Příspěvky: 22
Registrován: září 13
Pohlaví: Nespecifikováno
Stav:
Offline

VBA z buňky do komentáře

Příspěvekod Majk1976 » 19 lis 2014 09:57

Dobrý den, mohl by mi někdo upravit makro v příloze a to tak aby se komentář vložil ale už se nemazal.
Tzn. Vlož komentář když číslo a když už komentář je tak pokračuj.

Díky předem za pomoc

Vlákno jsem rozšířil o další požadavky.
Přílohy
hodnota bunky do komentare.xlsm
(17.69 KiB) Staženo 38 x
Naposledy upravil(a) Majk1976 dne 30 lis 2014 16:51, celkem upraveno 1 x.

Reklama
cmuch
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod cmuch » 19 lis 2014 10:34

Nevím co přesně potřebuješ, jestli komentář ponechat stávající nebo za stávající další přidat.

Za stávající přidat další třeba takto

Kód: Vybrat vše

With Range(bunka).Offset(0, 2)  'pridej komentar o dve bunky doprava
        On Error Resume Next
        '.ClearComments
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=.Comment.Text & Chr(10) & Range(bunka).Text
        On Error GoTo 0
    End With


A pokud ponechat tak třeba takto

Kód: Vybrat vše

With Range(bunka).Offset(0, 2)  'pridej komentar o dve bunky doprava
      On Error Resume Next
      If .Comment.Text = False Then 'pokud koment není pridej
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=Range(bunka).Text
      End If
      On Error GoTo 0
    End With
Naposledy upravil(a) cmuch dne 19 lis 2014 18:03, celkem upraveno 1 x.

Majk1976
nováček
Příspěvky: 22
Registrován: září 13
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod Majk1976 » 19 lis 2014 12:51

No když už je komentář vložen, tak aby zůstal a nepřepisoval se. Tohle makro jsem vložil a hlásí mi chybu. Zatím se stále učím a nevím kde je chyba

cmuch
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod cmuch » 19 lis 2014 12:57

To co jsem poslal tak musíš vložit místo původního With .

Majk1976
nováček
Příspěvky: 22
Registrován: září 13
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod Majk1976 » 19 lis 2014 13:08

stále mi to hlásí chybu. Doufám , že jsem správně napsal aby v případě , že ve sloupci "D" je číslo tak dej komentář o dvě buňky do prava a když už tam komentář je tak nic nevkládej a pokračuj dál. A moc prosím mohl by jsi mi to vložit do té přílohy nahoře? myslím že to vkládám dobře ale chybu mi to hlásí stále

cmuch
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod cmuch » 19 lis 2014 15:44

Chyba nebyla u tebe.
Špatně jsem testoval.

Kód: Vybrat vše

Sub PridejKomentar()
'
Dim bunka As Variant
Dim radek As Integer

 For radek = 1 To Cells(Rows.Count, "D").End(xlUp).Row  'opakuj pro radky od 1 do posledniho obsazeneho

  bunka = Cells(radek, "D").Address 'bunka co se ma kontrolovat
 
  If IsNumeric(Range(bunka)) And Not IsEmpty(Range(bunka)) Then 'je cislo v bunce?
 
    With Range(bunka).Offset(0, 2)  'pridej komentar o dve bunky doprava
      On Error Resume Next
      If .Comment.Text = False Then 'pokud koment není pridej
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=Range(bunka).Text
      End If
      On Error GoTo 0
    End With
  End If
 Next radek
End Sub

Majk1976
nováček
Příspěvky: 22
Registrován: září 13
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod Majk1976 » 19 lis 2014 21:29

Chyba možná nebyla ve mě ale makro ted funguje bezvadně.
Díky moc


To cmuch: poslal jsem ti SZ

Majk1976
nováček
Příspěvky: 22
Registrován: září 13
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod Majk1976 » 28 lis 2014 13:32

Prosím můžete někdo kouknout kde mám chybu?
Má to prohledat oblast a tam kde není komentář a je datum tak vloží komentář, a když není datum ale je číslo tak taky. Když mám jen to datum tak to funguje, ale když tam přidám If IsNumeric tak to hodí chybu.
Vkládám i přílohu

Private Sub Worksheet_Change(ByVal Target As Range)

Dim bunka As Variant
Dim radek As Integer
Dim rng As Range
Dim com As Object
Dim cell As Range
Dim r As Double

Set wsh = ThisWorkbook.Worksheets(1)
With wsh

'posledni obsazeny radek v B
r = .Cells(Columns.Count, 2).End(xlUp).Row
'oblast hledani komentare
Set rng = .Range("B1:B" & "F1:F" & r)

'projde kazdou bunku v rng a hleda komentar
For Each cell In rng
'zjisti objekt com
Set com = cell.Comment

If Not com Is Nothing Then
'pokud com je, dale
GoTo dalsi
'pokud com neni, doplni se
Else
hodnota = cell.Offset(0, 0).Value

If IsDate(hodnota) = True Then
With cell 'pridej komentar
.AddComment
.Comment.Visible = False
.Comment.Text Text:=Format(Now, "yyyy-mm-dd hh:mm")
End With

Else
hodnotax = cell.Offset(0, 0).Value

If IsNumeric(hodnotax) = True Then
With cell
.AddComment
.Comment.Visible = False TADY MI TO HÁŽE CHYBU
.Comment.Text Text:=Format(Now, "yyyy-mm-dd hh:mm")
End With

Else
'hodnota neni cislo
GoTo dalsi
End If
End If
End If


GoTo dalsi

dalsi:
Next cell

End With



End Sub
Přílohy
Splatnost faktur s makrem_automatické_pridat k cislu.xlsm
(100.67 KiB) Staženo 27 x

cmuch
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod cmuch » 30 lis 2014 15:47

Tady je uprava, ale nevím zda dobře chápu záměr toho makra.

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)

Dim bunka As Variant
Dim radek As Integer
Dim rng As Range
Dim com As Object
Dim cell As Range
Dim r As Double
Dim wsh As Worksheet
Dim hodnota As Variant
Dim hodnotax As Variant

Set wsh = ThisWorkbook.Worksheets(1)
With wsh

'posledni obsazeny radek v B
r = .Cells(Columns.Count, 2).End(xlUp).Row
'oblast hledani komentare
Set rng = .Range("B2:B" & r, "F2:F" & r)

'projde kazdou bunku v rng a hleda komentar
For Each cell In rng
'zjisti objekt com
Set com = cell.Comment

If Not com Is Nothing Then
'pokud com je, dale
GoTo dalsi
'pokud com neni, doplni se
Else
hodnota = cell.Offset(0, 0).Value

If IsDate(hodnota) = True Then
With cell 'pridej komentar
.AddComment
.Comment.Visible = False
.Comment.Text Text:=Format(Now, "yyyy-mm-dd hh:mm")
End With

Else
hodnotax = cell.Offset(0, 0).Value

If IsNumeric(hodnotax) = True And IsEmpty(hodnotax) = False Then
With cell
.AddComment
.Comment.Visible = False
.Comment.Text Text:=Format(Now, "yyyy-mm-dd hh:mm")
End With

Else
'hodnota neni cislo
GoTo dalsi
End If
End If
End If
dalsi:
Next cell
End With
End Sub



'oblast hledani komentare
Set rng = .Range("B2:B" & r, "F2:F" & r)

toto vsadí komentář do oblast B2:Fr
ty si máš
'oblast hledani komentare
Set rng = .Range("B1:B" & "F1:F" & r)

to vsadí komentář B1:poslední sloupec excelu r
Ale ty spíš asi potřebuješ aby dávalo komenty jen do sloupce B a F. Ale třeba se pletu.

Ta chyba proč tam skáče je způsobená sloučenýma buňkama v prvním řádku.
Proto jsem změnil oblast na B2:Fr

Majk1976
nováček
Příspěvky: 22
Registrován: září 13
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod Majk1976 » 30 lis 2014 16:42

Díky za pomoc , protože přesně tohle potřebuju. Akorát mi to hází komentáře i do sloupců C a D to znamená od B do F, dá se to upravit aby to házelo komentář jen do B a F ?

cmuch
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: VBA z buňky do komentáře

Příspěvekod cmuch » 30 lis 2014 18:07

Tady jsem to trochu učesal.

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim com As Object
Dim cell As Range
Dim r As Long
Dim wsh As Worksheet
Dim hodnota As Variant

Set wsh = ThisWorkbook.Worksheets(1)
With wsh

 'posledni obsazeny radek v B
 r = .Cells(Columns.Count, 2).End(xlUp).Row
 'oblast hledani komentare (az 30oblasti)
 Set rng = Application.Union(.Range("B2:B" & r), .Range("F2:F" & r))

 'projde kazdou bunku v rng a hleda komentar
 For Each cell In rng
  'zjisti objekt com
  Set com = cell.Comment
  'pokud com je, dale
    If Not com Is Nothing Then GoTo dalsi
      'pokud com neni, doplni se
      hodnota = cell.Offset(0, 0).Value
      'pokud je datum nebo cislo a bunka neni prazdna
      If IsDate(hodnota) = True _
        Or (IsNumeric(hodnota) = True And IsEmpty(hodnota) = False) Then
        With cell 'pridej komentar
          .AddComment
          .Comment.Visible = False
          .Comment.Text Text:=Format(Now, "yyyy-mm-dd hh:mm")
        End With
      End If
dalsi:
  Next cell
 End With
End Sub

Majk1976
nováček
Příspěvky: 22
Registrován: září 13
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA z buňky do komentáře  Vyřešeno

Příspěvekod Majk1976 » 30 lis 2014 19:16

děkuji ti cmuch , jelikož tohle je přesně ten výsledek , který jsem potřeboval.
A ještě je to VBA o mnoho přehlednější.

Díky moc za pomoc


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 9 hostů