エクセル2010です。
下記のようなコードでOutlookメールを作成したとき、たとえば
"ABC株式会社"
だけを赤字で太文字にするにはどう書けばよいのでしょうか？
Sub TEST001()
Dim oApp As Object
Dim objMAIL As Object
Dim strMOJI(1) As String
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
Set oApp = CreateObject("Outlook.Application")
End If
Set objMAIL = oApp.CreateItem(0)
strMOJI(0) = "こんにちは！" & vbCrLf & _
"色付けテストです。" & vbCrLf & _
"よろしくおねがいします。" & vbCrLf
strMOJI(1) = vbCrLf & _
"以上です。" & vbCrLf & _
"ABC株式会社" & vbCrLf & _
"emaxemax"
objMAIL.To = "xxxx@xxx.co.jp"
objMAIL.CC = "yyyy@xxx.co.jp"
objMAIL.Subject = "テスト"
objMAIL.Body = strMOJI(0) & strMOJI(1)
objMAIL.Display
End Sub
エクセル2010です。
下記のようなコードでOutlookメールを作成したとき、たとえば
"ABC株式会社"
だけを赤字で太文字にするにはどう書けばよいのでしょうか？
Sub TEST001()
Dim oApp As Object
Dim objMAIL As Object
Dim strMOJI(1) As String
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
Set oApp = CreateObject("Outlook.Application")
End If
Set objMAIL = oApp.CreateItem(0)
strMOJI(0) = "こんにちは！" & vbCrLf & _
"色付けテストです。" & vbCrLf & _
"よろしくおねがいします。" & vbCrLf
strMOJI(1) = vbCrLf & _
"以上です。" & vbCrLf & _
"ABC株式会社" & vbCrLf & _
"emaxemax"
objMAIL.To = "xxxx@xxx.co.jp"
objMAIL.CC = "yyyy@xxx.co.jp"
objMAIL.Subject = "テスト"
objMAIL.Body = strMOJI(0) & strMOJI(1)
objMAIL.Display
End Sub
「ExcelVBA別フォルダにあるブックのコピー方法」
http://okwave.jp/qa/q8488933.html
上記質問でコードを教えていただきました。
自分で編集しようと思ったのですが、どうにもうまくいきません。
編集したい内容としては、
出力する「ファイルC」に複数のシートがあるので、
それぞれのシートを指定して値をコピーしたいのです。
でも、別のシート名の指定がうまくいきません。
シートはフォーマットが決まったものが配置されているのですが、
1つのシートごとに数が異なります。
'//////////////////////////////////////////////////////
Private Sub CommandButton1_Click()
Dim vTgYear As Variant
Dim sht結果 As Worksheet, sht上小 As Worksheet
Dim sht保存 As Worksheet
Dim sht元データ As Worksheet
Dim sMyDir As String
Dim sWbkFullName As String
Dim sWbkName2 As String
Dim sShtName As String
Dim sMsg As String
Dim i As Long
Dim seru As Range
vTgYear = ComboBox1.Value ' ●
If Not vTgYear Like "####" Then
MsgBox "年次を指定してからやり直し", vbExclamation
Exit Sub
End If
Select Case vTgYear
Case 1999 To 2012 ' ●
Case Else
MsgBox "1999～2012の間で年次を指定してからやり直し", vbExclamation ' ●
Exit Sub
End Select
sMyDir = ThisWorkbook.Path & "\"
With Application
.ScreenUpdating = False
' .DisplayAlerts = False
.Calculation = xlCalculationManual
End With
' ' ファイルC_結果.xls を開く
sWbkFullName = sMyDir & "3_フォルダC\ファイルC_結果.xls" '●
sShtName = "地域A" '●
On Error Resume Next
Set sht結果 = Workbooks.Open(sWbkFullName).Sheets(sShtName)
On Error GoTo 0
If sht結果 Is Nothing Then
MsgBox sWbkFullName & vbLf & sShtName & vbLf & "開くことが出来ませんでした", vbExclamation
Exit Sub
End If
' ' 出力先のセル範囲を値消去
sht結果.Range("D7:F44,H7:J44,L7:L44,N7:Q44").ClearContents
' ' 前年～翌年、ループ
For i = -1 To 1
' ' 1_フォルダA
sWbkFullName = sMyDir & "1_フォルダA\" & vTgYear + i & "_ファイルA.xls"
sShtName = "Sheet1"
On Error Resume Next
Set sht元データ = Workbooks.Open(sWbkFullName).Sheets(sShtName)
On Error GoTo 0
If sht元データ Is Nothing Then
sMsg = sMsg & vbLf & "●" & sWbkFullName & vbLf & sShtName
Else
sht結果.Range("E7:E25").Offset(, i).Value = sht元データ.Range("C5:C23").Value
sht結果.Range("E26:E44").Offset(, i).Value = sht元データ.Range("D5:D23").Value
sht元データ.Parent.Close SaveChanges:=False
Set sht元データ = Nothing
End If
' ' 2_フォルダB
sWbkFullName = sMyDir & "2_フォルダB\" & vTgYear + i & "_ファイルB.xls" '●
sShtName = "Sheet1" '●
On Error Resume Next
Set sht元データ = Workbooks.Open(sWbkFullName).Sheets(sShtName)
On Error GoTo 0
If sht元データ Is Nothing Then
sMsg = sMsg & vbLf & "●" & sWbkFullName & vbLf & sShtName
Else
sht結果.Range("I7:I25").Offset(, i).Value = sht元データ.Range("C5:C23").Value
sht結果.Range("I26:I44").Offset(, i).Value = sht元データ.Range("C25:C43").Value sht元データ.Parent.Close SaveChanges:=False
Set sht元データ = Nothing
End If
Next i
' ' "ファイルC_2006～2008年結果.xls"形式の名前を付け保存して閉じる
Application.DisplayAlerts = False
sht結果.SaveAs Filename:=sMyDir & "3_フォルダC\" & ComboBox1.Value & "_ファイルC.xls" ' ●
Application.DisplayAlerts = True
With Application
.ScreenUpdating = True
' .DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
Set sht結果 = Nothing
If sMsg = "" Then
MsgBox Label1.Caption & vbLf & "処理完了", vbInformation
Else
MsgBox sMsg & vbLf & "開くことが出来ませんでした", vbExclamation
End If
End Sub
'//////////////////////////////////////////////////////
文字数制限のため全てのコードを書けなかったのですが、
(1)フォルダは複数ある
(2)データ元のコピー方法は3種類
(1)コンボボックスで選択した前後2年のファイルの値をコピーする
(2)コンボボックスで選択した年次のみのファイルの値をコピーする
(3)範囲がどの結果の範囲に対しても同一の場合がある
(1)(2)は教えていただいたコードでクリアしているのですが、
前の質問の時に結果のファイルにシートが複数あるのをお伝えするのを忘れてしまいました。
結果ファイルの複数のシートにコピーするにはどのように編集したらよいのか教えていただけますと幸いです。
締め切りが近くとても焦っています。
自分でどうにかできないのがお恥ずかしいのですが、どうかよろしくお願い致します。
ご回答ありがとうございました。
これといった資料がなく(探し方が悪いのかもしれませんが)、少ない経験値で複雑なというか面倒な処理のマクロ(VBA)を組まされることになり、困っているところです。当初の話だと「勉強しながらでよい」ということだったのですが、いろいろと仕事が次々と舞い込んできて、そんな余裕もなくせっぱ詰まり少ない知識で必死にやっています。
先にご回答いただいた内容で是非アドバイスをいただきたいと思い、新たに質問させていただきました。
ユーザーフォームでマルチページを作っています。そこでもコンボボックスを使うのですがそこの記述方法をアドバイス下さい。やっぱり記述場所がおかしいのか、クリックするとリストの内容がコンボボックスをクリックした分だけ繰り返してしまうことがあります。
//////////////////////////////////////////////////////
Private Sub UserForm_Initialize()
Dim sh As Worksheet
Set sh = Worksheets("対象年")
Dim i As Integer
Dim lastRow As Integer
lastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
With ComboBox1
For i = 2 To lastRow
If ComboBox1 = "" Then
.AddItem sh.Cells(i, 1).Value
End If
Next i
End With
End Sub
//////////////////////////////////////////////////////
Private Sub ComboBox1_DropButtonClick()
Dim sh As Worksheet
Set sh = Worksheets("対象年")
Dim i As Integer
Dim lastRow As Integer
lastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
With ComboBox1
For i = 2 To lastRow
If ComboBox1 = "" Then
.AddItem sh.Cells(i, 1).Value
End If
Next i
End With
End Sub
//////////////////////////////////////////////////////
とまぁ、結局コードは同じなのですが。
それと、結果をラベルに出させる場合には回答で記述いただいた
//////////////////////////////////////////////////////
Private Sub ComboBox1_Change()
Dim vTgYear As Variant
vTgYear = ComboBox1.Value
Label1.Caption = vTgYear - 1 & "～" & vTgYear + 1 & "年"
End Sub
//////////////////////////////////////////////////////
で、よいでしょうか？
よろしくお願いいたします。
Excelのワークシートでコンボボックスを設定する方法を教えてください。
「フォームコントロール」と「ActiveXコントロール」の違いがわかりません。
添付の画像の通りコンボボックスに西暦を入力(別シートに入力済みの値を表示するように設定)してあるのですが、ファイルを保存しているにも関わらず、再度ファイルを開くとコンボボックスの中のリストは空欄になってしまいます。
今は「ActiveXコントロール」のコンボボックスで設定しています。
コードは以下のように設定してみたのですが、設定内容や設定箇所が違うのでしょうか？
//////////////////////////////////////////////////////
Private Sub ComboBox1_DropButtonClick()
Dim sh As Worksheet
Set sh = Worksheets("マクロ")
Dim i As Integer
Dim lastRow As Integer
lastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
With ComboBox1
For i = 2 To lastRow
If ComboBox1 = "" Then
.AddItem sh.Cells(i, 1).Value
End If
Next i
End With
End Sub
//////////////////////////////////////////////////////
コンボボックスのリストの内容が消えてしまうので、
コードの内容は同じで以下のところにもコードを書いてみました。
//////////////////////////////////////////////////////
Private Sub Worksheet_Activate()
Dim sh As Worksheet
Set sh = Worksheets("マクロ")
Dim i As Integer
Dim lastRow As Integer
lastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
With ComboBox1
For i = 2 To lastRow
If ComboBox1 = "" Then
.AddItem sh.Cells(i, 1).Value
End If
Next i
End With
End Sub
//////////////////////////////////////////////////////
なんだかもう、訳がわからずぐちゃぐちゃです。
コンボボックスの中に値が入っていると、実行ボタンをクリックしたときは正常にやりたい結果を出すことが実現できます。
ファイルを閉じた後に再度開いてもコンボボックスの中に値があるようにするにはどうしたらよいのか、ド素人の私にご教授いただきたくお願いいたします。
A列の幅を、C～F列の幅（同一ではありません）に設定しようと思いました。
ところが
Columns("A").ColumnWidth = Range("C1:F1").Width
とすると、ColumnWidthとWidthの単位がまったく違うのでエラーになります。
同じ単位で設定するには
Columns("A").ColumnWidth = Columns("C").ColumnWidth + Columns("D").ColumnWidth + Columns("E").ColumnWidth + Columns("F").ColumnWidth
とするか、
Sub test02()
Dim c As Range
Dim x As Single
For Each c In Range("C1:F1")
x = x + c.ColumnWidth
Next
Columns("A").ColumnWidth = x
End Sub
などのように手の込んだことをするしか思いつきません。
もっと簡単な方法はないでしょうか？
A列の幅を、C～F列の幅（同一ではありません）に設定しようと思いました。
ところが
Columns("A").ColumnWidth = Range("C1:F1").Width
とすると、ColumnWidthとWidthの単位がまったく違うのでエラーになります。
同じ単位で設定するには
Columns("A").ColumnWidth = Columns("C").ColumnWidth + Columns("D").ColumnWidth + Columns("E").ColumnWidth + Columns("F").ColumnWidth
とするか、
Sub test02()
Dim c As Range
Dim x As Single
For Each c In Range("C1:F1")
x = x + c.ColumnWidth
Next
Columns("A").ColumnWidth = x
End Sub
などのように手の込んだことをするしか思いつきません。
もっと簡単な方法はないでしょうか？
独学でVBAを始めて1ヶ月の初心者です。
下記のコードについて質問です。
シート"strage２"のA1からA15のデータをシート"strage1"と比較し、違ったら更新します。
更新したデータだけを、まとめてメッセージボックスで返したいのです。
しかし、返してくるのは一番最後に処理した値だけなのです。
何が間違いでしょうか？
ご指南よろしくお願いいたします。
---------------------------
Sub 何を書き換えたかMsgBox()
Dim i As Integer
Dim myMsg As String
i = 1
For i = i To 15
If Sheets("strage1").Cells(i, 1) <> Sheets("strage2").Cells(i, 1) Then
myMsg = Sheets("strage1").Cells(i, 1).Value & "から" & Sheets("strage2").Cells(i, 1) & "に変更しました" & vbCrLf
Sheets("strage1").Cells(i, 1).Value = Sheets("strage2").Cells(i, 1)
Else
End If
Next i
MsgBox myMsg
End Sub
--------------------------------------
以上です。よろしくお願いします。
