Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3098 / 13644 ツリー ←次へ | 前へ→

【64227】wordからの貼付について らいち 10/1/27(水) 9:43 質問[未読]
【64232】Re:wordからの貼付について らいち 10/1/27(水) 11:12 質問[未読]
【64254】Re:wordからの貼付について n 10/1/28(木) 13:03 発言[未読]
【64258】Re:wordからの貼付について らいち 10/1/28(木) 16:24 質問[未読]
【64262】Re:wordからの貼付について n 10/1/28(木) 23:10 発言[未読]
【64265】Re:wordからの貼付について n 10/1/28(木) 23:38 発言[未読]
【64271】Re:wordからの貼付について らいち 10/1/29(金) 13:17 お礼[未読]

【64227】wordからの貼付について
質問  らいち  - 10/1/27(水) 9:43 -

引用なし
パスワード
   管理台帳をexcelで作成しており、B列にタイトルを入れる
表があります。
このB列に直接入力できるほか、wordからの文章を範囲指定
してコピー&ペーストできるようにしたいのですが、
wordからexcelに貼り付けようとすると、B列の書式や罫線が
消えてしまいます。
貼り付けたいセルをダブルクリックしてから貼り付けると
問題ないのですが、作業者によってはダブルクリックをせずに
貼り付ける場合もあり、困ってます。
そのため、ダブルクリックせずに貼り付けたら、
メッセージを表示(再試行)して、貼り付け前の状態に戻る
ようにVBAを設定したいのですが、どうすればよろしいでしょうか。
B列の範囲はB5:B3000です。

よろしくお願いします。

【64232】Re:wordからの貼付について
質問  らいち  - 10/1/27(水) 11:12 -

引用なし
パスワード
   ▼らいち さん:
>管理台帳をexcelで作成しており、B列にタイトルを入れる
>表があります。
>このB列に直接入力できるほか、wordからの文章を範囲指定
>してコピー&ペーストできるようにしたいのですが、
>wordからexcelに貼り付けようとすると、B列の書式や罫線が
>消えてしまいます。
>貼り付けたいセルをダブルクリックしてから貼り付けると
>問題ないのですが、作業者によってはダブルクリックをせずに
>貼り付ける場合もあり、困ってます。
>そのため、ダブルクリックせずに貼り付けたら、
>メッセージを表示(再試行)して、貼り付け前の状態に戻る
>ようにVBAを設定したいのですが、どうすればよろしいでしょうか。
>B列の範囲はB5:B3000です。
>
>よろしくお願いします。

追記です。
B列に入力したタイトルについて、作業者によっては改行や
半角全角がバラバラに入力されるので、excelを閉じる時に
ASC(TRIM(CLEAN()))で
をB5:B3000に入力されたタイトル表示形式を統一させたいのですが
どうすればよろしいでしょうか。

【64254】Re:wordからの貼付について
発言  n  - 10/1/28(木) 13:03 -

引用なし
パスワード
   >メッセージを表示(再試行)して、貼り付け前の状態に戻る...

If MsgBox("戻す?", vbYesNo) = vbYes Then
  Application.Undo
End If
みたいな感じですが、何をトリガーにして実行するか、ですね。
B5:B3000に薄く色をつけておけば
If ...Interior.ColorIndex = xlNone Then
で判定するWorksheet_Changeイベントが使えそうな気がしますが。

>ASC(TRIM(CLEAN()))で
そのまま
With Application
  Range("B5:B10").Value = .Asc(.Trim(.Clean(Range("B5:B10"))))
End With
などで。
B5以下のデータがある範囲に限定すると良いでしょう。

もしくはWorksheet_Changeイベントを使って、入力時にチェックするのでも良いかと。

【64258】Re:wordからの貼付について
質問  らいち  - 10/1/28(木) 16:24 -

引用なし
パスワード
   nさんへ

いつも有難う御座います。
ASC(TRIM(CLEAN()))の方はうまくいきましたが、
もう一方の貼り付け前の状態に戻る方がうまくいきません。
下記コードを入れても、無反応でした。
恐らくコード記載方法が違うと思いますが、
正直、よく分かりません。
お手数をお掛けしますが、ご指導の程、お願い致します。
D5:D3000(B列でなくD列でした)に薄く色付けしてます。

Private Sub Worksheet1_Change(ByVal Target As Range)
  Dim sng As Range
  Dim s  As Range
  Set sng = Intersect(Target, Rows("5:3000"), _
            Range("D:D"))
  If Not sng Is Nothing Then
    Application.EnableEvents = False
    ActiveSheet.Unprotect
    For Each s In sng
      If s.Interior.ColorIndex = xlNone Then
        Exit Sub
      Else
       If MsgBox("戻す?", vbYesNo) = vbYes Then
        Application.Undo
       End If
    Next
    ActiveSheet.Protect
    Application.EnableEvents = True
    Set sng = Nothing
  End If
End Sub

▼n さん:
>>メッセージを表示(再試行)して、貼り付け前の状態に戻る...
>
>If MsgBox("戻す?", vbYesNo) = vbYes Then
>  Application.Undo
>End If
>みたいな感じですが、何をトリガーにして実行するか、ですね。
>B5:B3000に薄く色をつけておけば
>If ...Interior.ColorIndex = xlNone Then
>で判定するWorksheet_Changeイベントが使えそうな気がしますが。
>
>>ASC(TRIM(CLEAN()))で
>そのまま
>With Application
>  Range("B5:B10").Value = .Asc(.Trim(.Clean(Range("B5:B10"))))
>End With
>などで。
>B5以下のデータがある範囲に限定すると良いでしょう。
>
>もしくはWorksheet_Changeイベントを使って、入力時にチェックするのでも良いかと。

【64262】Re:wordからの貼付について
発言  n  - 10/1/28(木) 23:10 -

引用なし
パスワード
   >下記コードを入れても、無反応でした。

>Private Sub Worksheet1_Change(ByVal Target As Range)
余計な 1 がついてます。
イベントプロシージャはコードウィンドウ上部の
(General)▼ (Declarations)▼
から選択してコード入力してください。

>If s.Interior.ColorIndex = xlNone Then
End If がありません。

>If s.Interior.ColorIndex = xlNone Then
>  Exit Sub
>Else
Application.EnableEvents = False
で Exit Sub はまずいです。
それ以降イベントプロシージャが無効になります。

>For Each s In sng
Application.Undo が目的なので
Loopせず、sng.Item(1)で1回だけ判定すれば良いです。

>ActiveSheet.Unprotect
目的からしてこれも不要では。

【64265】Re:wordからの貼付について
発言  n  - 10/1/28(木) 23:38 -

引用なし
パスワード
   #ひっぱっても時間的余裕が私にないので

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range
  
  Set rng = Intersect(Target, Range("D5:D3000"))
  If Not rng Is Nothing Then
    If rng(1).Interior.ColorIndex = xlNone Then
      If MsgBox("戻す?", vbYesNo) = vbYes Then
        With Application
          .EnableEvents = False
          .Undo
          .EnableEvents = True
        End With
      End If
    End If
    Set rng = Nothing
  End If
End Sub

【64271】Re:wordからの貼付について
お礼  らいち  - 10/1/29(金) 13:17 -

引用なし
パスワード
   nさん

ご多忙のところ、こと細かにご指導頂き
有難う御座いました。

まったく問題なく作動しました。感服です。
今回もお手数をお掛けしました。

3098 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free