戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 親トピックをトピックトップへ ]
このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 

このトピック参照回数 :
Re[13]: 指定した行にある図形の削除??

    [195959] Re[13]: 指定した行にある図形の削除??-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ mizuesan -(2023/09/25(13:06))
    □U R L/

      半平太さん!出来ました!ありがとうございます
      いただいたマクロを理解できるよう勉強します。
      どうしてもわからない時はまた質問させていただきます。
      本当にありがとうございました!




    [195958] Re[12]: 指定した行にある図形の削除??-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/09/25(12:40))
    □U R L/
      なるほど、D列スタートの矢印は存在しないですね。
      
      更に、短い矢印が D→I列 に何本かあって、そのすべてを削除するなら、以下のコードで。
      
      Sub sakujo()
          Dim i As Long
          Dim LR As Long
          Dim actWsh As Worksheet
          Dim anArrow As Shape, idx As Long
          Dim dicT As Object, ky, NMs
          
          'D列からI列の間にある矢印オブジェクトを洗い出してその名称をDictionaryに登録する
          
          Set dicT = CreateObject("Scripting.Dictionary")
          
          Set actWsh = ActiveSheet
          
          For Each anArrow In actWsh.Shapes
              
              If anArrow.Type = msoLine Then
                  If 4 <= anArrow.TopLeftCell.Column And anArrow.TopLeftCell.Column <= 9 Then
                      ky = anArrow.TopLeftCell.Row
                      dicT(ky) = dicT(ky) & "♪" & anArrow.Name
                  End If
              End If
          Next
          
          LR = Cells(Rows.Count, 2).End(xlUp).Row
          
          Range(Cells(6, 2), Cells(LR, 2)).Interior.Pattern = xlNone
          
          With Range(Cells(6, 2), Cells(LR, 9))
              .Borders.LineStyle = xlContinuous
              .BorderAround Weight:=xlMedium
              .RowHeight = 30
          End With
          
          For i = 6 To LR
              
              Select Case Cells(i, 3)
                  Case "土", "日", "祝"
                      Range(Cells(i, 2), Cells(i, 9)).Interior.Color = RGB(242, 220, 219)
                      Range(Cells(i, 2), Cells(i, 9)).RowHeight = 13.5
                      Range(Cells(i, 4), Cells(i, 9)) = ""
                      Range(Cells(i, 4), Cells(i, 9)).Borders(xlDiagonalUp).LineStyle = xlLineStyleNone
                      
                      '                ★ここに記述したいです★
                      If dicT.exists(i) Then
                          NMs = Split(dicT(i), "♪")
                          
                          For idx = 1 To UBound(NMs)
                              actWsh.Shapes(NMs(idx)).Delete
                          Next
                      End If
                      
                  Case Else
              End Select
          Next i
          
          dicT.RemoveAll
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195957] Re[11]: 指定した行にある図形の削除??-

    記事引用/メール受信=OFF■

    □投稿者/ mizuesan -(2023/09/25(12:34))
    □U R L/

      半平太さん すみません。前の質問の部分見逃してました

      Straight Connector 56 $E$90 $G$90
      Straight Arrow Connector 57 $E$91 $H$91
      Straight Arrow Connector 58 $E$95 $H$95
      Straight Connector 68 $E$93 $G$93
      Straight Connector 69 $H$93 $I$93
      Straight Connector 70 $G$94 $H$94

      と表示されました よろしくお願いします




    [195956] Re[10]: 指定した行にある図形の削除??-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/09/25(12:11))
    □U R L/
      上と下のIF、End ID を外して、これだけで再実行してみると、イミディエイトウィンドウにどう出ますか?
                                    ↓
               Debug.Print anArrow.Name, anArrow.TopLeftCell.Address, anArrow.BottomRightCell.Address
      
      この結果を教えて頂けませんか?
      
      
      




    [195955] Re[9]: 指定した行にある図形の削除??-

    記事引用/メール受信=OFF■

    □投稿者/ mizuesan -(2023/09/25(12:01))
    □U R L/

      半平太さん 返信ありがとうございます

      矢印は大抵1本ですがたまに2本のときもあります
      そのときの時間割によるので。うまく説明できてなくてすみません。
      宜しくお願いします




    [195954] Re[8]: 指定した行にある図形の削除??-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/09/25(11:54))
    □U R L/

      >長さは可変の矢印(図形)がD列からI列にあれば削除したいのですが、

      ところで、その説明で私は、DからIに一本の矢印が引かれていると解釈したのですが、
      短い矢印が何本あっても、この説明になりますね?

      実際はどうなんでしょうか?




    [195953] Re[7]: 指定した行にある図形の削除??-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/09/25(11:50))
    □U R L/
      >上記のマクロ実行してみてもイミディエイトに何も書き込まれてません
      と言うことは、D列スタートの矢印は存在しないと言うことになります(エクセル君の解釈としてはですけど)
      
      全部書き出してチェックするしかないです。
      
      If anArrow.TopLeftCell.Column = 4 Then’チェックの為、矢印情報書き出し
      >            Debug.Print anArrow.Name, anArrow.TopLeftCell.Address, anArrow.BottomRightCell.Address
      End If
      
      上と下のIF、End ID を外して、これだけで再実行してみると、イミディエイトウィンドウにどう出ますか?
                                    ↓
               Debug.Print anArrow.Name, anArrow.TopLeftCell.Address, anArrow.BottomRightCell.Address
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195952] Re[6]: 指定した行にある図形の削除??-

    記事引用/メール受信=OFF■

    □投稿者/ mizuesan -(2023/09/25(11:45))
    □U R L/

      半平太さん 何度もすみません

      上記のマクロ実行してみてもイミディエイトに何も書き込まれてません
      Ctrl+G でイミディエイトウィンドウ見えるようにしてやってみたんですけど…

      ちなみにAlt+F10で見たら、マクロで引いた矢印は「直線コネクタ**」という名前がついていました
      無理そうならこの作業だけ手動でしたほうがいいでしょうか?
      まだ知識が足りなくて自分で案が出せずすみません。よろしくおねがいします




    [195951] Re[5]: 指定した行にある図形の削除-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/09/25(10:51))
    □U R L/
      >他に何か必要な情報などありますでしょうか?
      取り敢えず、以下のマクロを実行してください。
      
      中身は、いままでと同じですが、D列スタートの矢印の情報が
      イミディエイトウィンドウに書き出されるようになっています。
      
      その情報がどうなっているか教えてください。
      こんな情報が幾つか書かれているはずです。
        ↓
      Straight Connector 13       $D$12         $J$12
      
      
      Sub sakujo()
          Dim i As Long
          Dim LR As Long
          Dim actWsh As Worksheet
          Dim anArrow As Shape, idx As Long
          Dim dicT As Object, ky, NMs
          
          'D列からI列への矢印オブジェクトを洗い出してその名称をDictionaryに登録する
          
          Set dicT = CreateObject("Scripting.Dictionary")
          
          Set actWsh = ActiveSheet
          
          For Each anArrow In actWsh.Shapes
      
              If anArrow.TopLeftCell.Column = 4 Then’チェックの為、矢印情報書き出し
                  Debug.Print anArrow.Name, anArrow.TopLeftCell.Address, anArrow.BottomRightCell.Address
              End If
              
              If anArrow.Type = msoLine Then
                  If anArrow.TopLeftCell.Column = 4 And anArrow.BottomRightCell.Column = 10 Then
                      ky = anArrow.TopLeftCell.Address
                      dicT(ky) = dicT(ky) & "♪" & anArrow.Name
                  End If
              End If
          Next
          
          LR = Cells(Rows.Count, 2).End(xlUp).Row
          
          Range(Cells(6, 2), Cells(LR, 2)).Interior.Pattern = xlNone
          
          With Range(Cells(6, 2), Cells(LR, 9))
              .Borders.LineStyle = xlContinuous
              .BorderAround Weight:=xlMedium
              .RowHeight = 30
          End With
          
          For i = 6 To LR
              
              Select Case Cells(i, 3)
                  Case "土", "日", "祝"
                      Range(Cells(i, 2), Cells(i, 9)).Interior.Color = RGB(242, 220, 219)
                      Range(Cells(i, 2), Cells(i, 9)).RowHeight = 13.5
                      Range(Cells(i, 4), Cells(i, 9)) = ""
                      Range(Cells(i, 4), Cells(i, 9)).Borders(xlDiagonalUp).LineStyle = xlLineStyleNone
                      
                      '                ★ここに記述したいです★
                      If dicT.exists(Cells(i, "D").Address) Then
                          NMs = Split(dicT(Cells(i, "D").Address), "♪")
                          
                          For idx = 1 To UBound(NMs)
                              actWsh.Shapes(NMs(idx)).Delete
                          Next
                      End If
                      
                  Case Else
              End Select
          Next i
          
          dicT.RemoveAll
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195950] Re[4]: 指定した行にある図形の削除-

    記事引用/メール受信=OFF■

    □投稿者/ mizuesan -(2023/09/25(09:58))
    □U R L/

      半平太さん すぐに回答していただきありがとうございます

      上記部分を直して実行してみましたが、やはり矢印は消えませんでした
      何が違うのか私ではわかりません
      他に何か必要な情報などありますでしょうか?
      お手数をおかけしますがよろしくお願いします

      OS Win8.1    EXCEL Microsoft Office Standerd 2013




    [195949] Re[3]: 指定した行にある図形の削除-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/09/25(09:28))
    □U R L/
      If anArrow.Name Like "*Arrow*" Then
      If anArrow.TopLeftCell.Column = 4 And anArrow.BottomRightCell.Column = 9 Then
      
      上記2行 を 下記2行 に変更してみてください。(こちらではその処置で削除が成功しています)
      
        If anArrow.Type = msoLine Then
            If anArrow.TopLeftCell.Column = 4 And anArrow.BottomRightCell.Column = 10 Then
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195948] Re[2]: 指定した行にある図形の削除-

    記事引用/メール受信=OFF■

    □投稿者/ mizuesan -(2023/09/25(08:49))
    □U R L/
      半平太さん 回答ありがとうございます
      
      試してみたのですが罫線は消えたのですが、矢印は消えてくれませんでした
      矢印は1時間目から4時間目が同じ授業の場合2時間目から3時間目のところを範囲指定して線を引く下記のマクロで引いています。
      
      Sub 時間割用矢印()
      
      '選択した範囲内に右向きに開いた図形の矢印を作成します
        
        Dim X1, Y1, X2, Y2
          X1 = Selection.Left                           '始点の横
          Y1 = Selection.Top + Selection.Height / 2     '始点の縦
          X2 = Selection.Left + Selection.Width         '終点の横
          Y2 = Selection.Top + Selection.Height / 2     '終点の縦
        
        With ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Line
          .Weight = 0.5                           '太さは1
          .ForeColor.RGB = RGB(0, 0, 0)         '色は黒
          .EndArrowheadStyle = msoArrowheadOpen '終点を開いた右向き三角矢印
        End With
          
      End Sub
      
      説明がへたくそで済みませんが再度宜しくお願いします
      
      OS Win8.1    EXCEL Microsoft Office Standerd 2013


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195947] Re[1]: 指定した行にある図形の削除-

    記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/09/22(23:27))
    □U R L/
      >長さは可変の矢印(図形)
      これがどんなものか確信が持てないですが・・
      
      Sub sakujo()
          Dim i As Long
          Dim LR As Long
          
          'D列からI列への矢印オブジェクトを洗い出してその名称をDictionaryに登録する
          Dim actWsh As Worksheet
          Dim anArrow As Shape, idx As Long
          Dim dicT As Object, ky, NMs
          
          Set dicT = CreateObject("Scripting.Dictionary")    
          Set actWsh = ActiveSheet
          
          For Each anArrow In actWsh.Shapes
              If anArrow.Name Like "*Arrow*" Then
                  If anArrow.TopLeftCell.Column = 4 And anArrow.BottomRightCell.Column = 9 Then
                      ky = anArrow.TopLeftCell.Address
                      dicT(ky) = dicT(ky) & "♪" & anArrow.Name
                  End If
              End If
          Next
              
          LR = Cells(Rows.Count, 2).End(xlUp).Row
          
          Range(Cells(6, 2), Cells(LR, 2)).Interior.Pattern = xlNone
          
          With Range(Cells(6, 2), Cells(LR, 9))
              .Borders.LineStyle = xlContinuous
              .BorderAround Weight:=xlMedium
              .RowHeight = 30
          End With
          
          For i = 6 To LR
              
              Select Case Cells(i, 3)
                  Case "土", "日", "祝"
                      Range(Cells(i, 2), Cells(i, 9)).Interior.Color = RGB(242, 220, 219)
                      Range(Cells(i, 2), Cells(i, 9)).RowHeight = 13.5
                      Range(Cells(i, 4), Cells(i, 9)) = ""
                      Range(Cells(i, 4), Cells(i, 9)).Borders(xlDiagonalUp).LineStyle = xlLineStyleNone
      
      '                ★ここに記述したいです★
                      If dicT.exists(Cells(i, "D").Address) Then
                          NMs = Split(dicT(Cells(i, "D").Address), "♪")
                          
                          For idx = 1 To UBound(NMs)
                              actWsh.Shapes(NMs(idx)).Delete
                          Next
                      End If
                      
                  Case Else
              End Select
          Next i
          
          dicT.RemoveAll
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195946] 指定した行にある図形の削除-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ mizuesan -(2023/09/22(14:26))
    □U R L/
      OS Win8.1    EXCEL Microsoft Office Standerd 2013
      
      時間割のシートがあります
      B列は日付(2013/3/22と入力、表示形式9月22日)、C列は曜日 Format(Cells(i, 2).Value, "aaa")で設定した曜日の文字が入っています。、D(1時限)E(2時限)…I(6時限)で同じ授業の最初の時限には科目、以降の時限は矢印(図形)、授業の無い時間は罫線(左下から右上)が入っています
      C列が土or日or祝だった場合、長さは可変の矢印(図形)がD列からI列にあれば削除したいのですが、どのように記述したらよいのかを教えてほしいです
      宜しくお願い致します
      
      
      sub sakujo()
      
      Dim i As Long
      Dim LR As Integer
      
      
          LR = Cells(Rows.Count, 2).End(xlUp).Row
      
          Range(Cells(6, 2), Cells(LR, 2)).Interior.Pattern = xlNone
      
          With Range(Cells(6, 2), Cells(LR, 9))
              .Borders.LineStyle = xlContinuous
              .BorderAround Weight:=xlMedium
              .RowHeight = 30
          End With
      
          For i = 6 To LR
          
           Select Case Cells(i, 3)
                  Case "土", "日", "祝"
                  Range(Cells(i, 2), Cells(i, 9)).Interior.Color = RGB(242, 220, 219)
                  Range(Cells(i, 2), Cells(i, 9)).RowHeight = 13.5
                  Range(Cells(i, 4), Cells(i, 9)) = ""
                  Range(Cells(i, 4), Cells(i, 9)).Borders(xlDiagonalUp) .LineStyle = xlLineStyleNone
      
      ★ここに記述したいです★
                
      Case Else
              End Select
              
          Next i
      
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他



このトピック内容の全ページ数 / [0]

- Child Forum -
Edit:ゆう-G