Word VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

357 / 886

←次へ　｜　前へ→


	【544】Re:エクセルに入力した文字列をワードに入力

H. C. Shinopy - 07/11/11(日) 23:41 -


	引用なし

	パスワード

A:B列にボタンを配置してマクロ実行ということですので、
前掲マクロを少し変えてみました。
御参考までに。

Sub MyShapeCmmdBttn()
　Dim myTitle As String
　Dim i As Long
　'
　Dim myCcAddr As String
　Dim x As Long
　Dim y As Long
　Dim myLeft As Long
　Dim myHeight As Long
　'
　Dim myShape As Shape
　Dim myOnAction As String
　'
　myTitle = "MyShapeCmmdBttn"
　'
　For i = 2 To 50
　　Cells(i, "A").Select
　　myCcAddr = ActiveSheet.Columns(ActiveCell.Column).Address(False, False)
　　myCcAddr = Left(myCcAddr, InStr(myCcAddr, ":") - 1)
　　x = ActiveSheet.Columns("A:B").Width　' ActiveCell.Width
　　y = ActiveSheet.Rows("1:" & ActiveCell.Row).Height
　　y = y - ActiveCell.Height
　　'
　　myLeft = 0
　　myHeight = ActiveSheet.Rows(ActiveCell.Row).Height
　　'
　　Set myShape = ActiveSheet.Shapes.AddFormControl(xlButtonControl, myLeft, y, x, myHeight)
　　'
　　With myShape
　　　.Name = ActiveCell.Address(False, False)
　　　.TextFrame.Characters.Text = Cells(ActiveCell.Row, "C").Value
　　　.AlternativeText = .Name
　　　myOnAction = myTitle & "MyRun" & " "
　　　myOnAction = myOnAction & Chr(&H22) & .Name & ChrW(&H22)
　　　.OnAction = "'" & myOnAction & "'"
　　End With
　Next ' i
End Sub ' MyShapeCmmdBttn ' *----*----*　　*----*----*　　*----*----*　　*----*----*

Sub MyShapeCmmdBttnMyRun(myAddress As String)
　Rem *----*----*　　*----*----*　　*----*----*　　*----*----*
　Rem コマンドボタンOnAction処理
　Rem *----*----*　　*----*----*　　*----*----*　　*----*----*
　Dim myWord As Variant ' Word.Application
　Dim myWordDoc As Variant ' Word.Document
　Dim myText As Variant
　'
　On Error Resume Next
　Set myWord = GetObject(, "Word.Application")
　If Err.Number <> 0 Then
　　Set myWord = CreateObject("Word.Application")
　　Set myWordDoc = myWord.Documents.Add
　　myWord.Visible = True
　End If
　On Error GoTo 0
　'
　Range(myAddress).Offset(0, 2).Select
　myText = ActiveCell.Value & " : " & ActiveCell.Offset(0, 1).Value
　myWord.Selection.TypeText myText & vbCrLf
　'
　myWord.WindowState = 2 ' wdWindowStateMinimize
End Sub ' MyShapeCmmdBttnMyRun ' *----*----*　　*----*----*　　*----*----*　　*----*----*

2,144 hits

▼

【539】エクセルに入力した文字列をワードに入力 ｋ．ぬま 07/10/30(火) 22:57