Excel VBA質問箱 IV

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

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


41082 / 76732 ←次へ | 前へ→

【40734】Re:吹出しの先っぽの位置を変えずに自動サイズ調整してほしい
発言  ichinose  - 06/7/21(金) 17:31 -

引用なし
パスワード
   ▼あくたいおん さん:
こんにちは。
Sendkeysは、動作が不安定な場合がありますから、
よくよくデバッグを繰り返してください。
Windowsによっても違うかもしれませんよ!!

このサイトで私が大変、お世話になったJuJuさんという方の

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=5831;id=excel

この投稿が私には、強く印象に残っていますし、
私自身も何度かSendkeysではうまく作動しない事例を経験したことがあります。

よって、再度私なら、「Sendkeysではなく、Inputboxやユーザーフォームで
テキストは入力させる」という仕様にするだるだろうなあ
ということをお断りして・・・。

'=====================================================================
Option Explicit
'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'コメントにしてありますが、これ入れるとCPUの占有率が下がる
'=========================================================================
Sub ふきだし()
  Dim vLeft, vtop, vHeight, vWidth As Long
  Dim txt As String
  Dim svx As Double, svy As Double
  With ActiveCell '位置調整
    vLeft = .Left + .Width + 22
    vtop = .Top - 15
    vHeight = 10
    vWidth = 50
  End With
  With ActiveSheet.Shapes.AddShape(msoShapeLineCallout3, vLeft, vtop, vWidth, vHeight)
    .Fill.ForeColor.RGB = RGB(255, 204, 204)
    With .Line
     .ForeColor.SchemeColor = 20
     .BeginArrowheadStyle = msoArrowheadOval
     .EndArrowheadStyle = msoArrowheadOval
     End With
    svx = Round((.Adjustments(1) * .Width + .Left) / 0.75, 0) * 0.75
    svy = Round((.Adjustments(2) * .Height + .Top) / 0.75, 0) * 0.75
    '↑ポイント1は、この上記の式なにやっているか解読してね
    With .TextFrame
     With .Characters
       .Text = ""
       With .Font
        .Name = "MS Pゴシック"
        .Size = 8
        End With
      
       End With
     End With
    .Select
    SendKeys " {BS}"
    On Error Resume Next
    Do While Selection.Name = .Name
     If Err.Number <> 0 Then Exit Do
     DoEvents
     'Sleep 100
'     これのコメントもはずして試してみてください
     Loop
    On Error GoTo 0
    .TextFrame.AutoSize = True
    .Adjustments(1) = (svx - .Left) / .Width
    .Adjustments(2) = (svy - .Top) / .Height
'    ↑ポイント2は、上記の式で自動サイズ調整後に再設定しています。
    End With
End Sub

後は、Autosize=Trueをどこで設定するかも仕様として決めなければなりませんね!!
0 hits

【40680】吹出しの先っぽの位置を変えずに自動サイズ調整してほしい あくたいおん 06/7/20(木) 13:01 質問
【40708】Re:吹出しの先っぽの位置を変えずに自動サ... ichinose 06/7/20(木) 20:16 発言
【40709】Re:吹出しの先っぽの位置を変えずに自動サ... bykin 06/7/20(木) 21:13 発言
【40731】Re:吹出しの先っぽの位置を変えずに自動サ... あくたいおん 06/7/21(金) 16:22 発言
【40727】Re:吹出しの先っぽの位置を変えずに自動サ... あくたいおん 06/7/21(金) 15:43 発言
【40734】Re:吹出しの先っぽの位置を変えずに自動サ... ichinose 06/7/21(金) 17:31 発言
【40740】Re:吹出しの先っぽの位置を変えずに自動サ... bykin 06/7/21(金) 23:36 回答
【40934】Re:吹出しの先っぽの位置を変えずに自動サ... あくたいおん 06/7/26(水) 15:35 質問
【40938】Re:吹出しの先っぽの位置を変えずに自動サ... ichinose 06/7/26(水) 16:11 発言
【40989】Re:吹出しの先っぽの位置を変えずに自動サ... あくたいおん 06/7/27(木) 13:20 質問
【41019】Re:吹出しの先っぽの位置を変えずに自動サ... ichinose 06/7/27(木) 19:48 発言
【41026】Re:吹出しの先っぽの位置を変えずに自動サ... bykin 06/7/27(木) 22:11 発言

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